VB中Excel 2010的导入导出操作
VB中Excel 2010的导入导出操作
编写人:左丘文
2015-4-11
近来这已是第二篇在讨论VB的相关问题,今天在这里,我想与大家一起分享一下在VB中如何从Excel中导入数据和导出数据到Excel(程序支持excel2010),在此做个小结,以供参考。有兴趣的同学,可以一同探讨与学习一下,否则就略过吧。
1、 程序导入导出操作介面:
2、 从excel导入数据代码:
2
3 'Modify By KevinZhang 2014-8-21
4 Dim sFile As String
5 Dim btrans As Boolean
6 sFile = txtFILE.Text
7 If Not FileExists(sFile) Then
8 MsgBox "指定的导入文件不存在,请重新选择!", vbOKOnly + vbExclamation
9 Exit Sub
10 End If
11 '连接excel
12 Dim conn
13 Set conn = CreateObject("ADODB.Connection")
14 'connExcelStr = "Provider = Microsoft.Jet.OLEDB.4.0 ; Data Source =" & sFile & ";Extended Properties='Excel 8.0;HDR=YES'"
15 'connExcelStr = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source =" & sFile & ";Extended Properties='Excel 12.0 Xml;HDR=YES;'"
16 'connExcelStr = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source =" & sFile & ";Extended Properties='Excel 8.0;HDR=YES;IMEX=1'"
17 connExcelStr = "Provider=Microsoft.ACE.OLEDB.12.0; Persist Security Info=False;Data Source=" & sFile & "; Extended Properties='Excel 8.0;HDR=Yes;IMEX=2'"
18 On Error GoTo checkgetexcel
19 conn.Open connExcelStr
20 Dim rs As ADODB.Recordset
21 Set rs = New ADODB.Recordset
22 With rs
23 .ActiveConnection = conn
24 .LockType = adLockReadOnly
25 .CursorLocation = adUseClient
26 .CursorType = adOpenKeyset
27 .Open "select * from [Sheet1$]"
28 End With
29
30
31 Dim rs2 As ADODB.Recordset
32 Set rs2 = New ADODB.Recordset
33 Dim i As Integer
34 If (rs.RecordCount >= 1) Then
35 i = rs.RecordCount
36
37 '*****************************************************************************
38 '同时生成一个错误清单
39
40 '定义变量
41 Dim j, k, o, z As Long
42
43 '初始化循环的变量数值
44 j = 2
45 '初始化Excel组建
46 Set xlApp = CreateObject("Excel.Application")
47 Set xlBook = xlApp.Workbooks.Add
48 Set xlsheet = xlBook.WorkSheets("Sheet1")
49
50 '打开选定的文件
51 'Set xlBook = xlApp.Workbooks.Open(sFile)
52 '设置其可见
53 'xlApp.Visible = True
54 '设置其工作表的名称
55 Set xlsheet = xlBook.WorkSheets("Sheet1") '设置活动工作表
56 '执行SQL连接方法,查询语句,和返回的文本
57
58 '循环,到数据库的总行
59 xlsheet.Cells(1, 1) = "料号" '给单元格(row,col)赋值
60 xlsheet.Cells(1, 2) = "单价" '给单元格(row,col)赋值
61 xlsheet.Cells(1, 3) = "错误信息" '给单元格(row,col)赋值
62
63 '***********************************************************************
64 Call ShowInforDlg("正在导入数据,请稍候...")
65 ConGamma.beginTrans
66 btrans = True
67 rs.MoveFirst
68 Do While Not rs.EOF
69 Set rs2 = ExecSQL("Insert_PackMat_Auto '" & txtYEAR.Text & " ','" & txtIQUARTER.Text & "' ,'" _
70 & rs!PRONUM & "','" & rs!price & "'", ConGamma)
71
72
73 If rs2.RecordCount = 1 Then
74
75 If rs2.Fields(0).Value = "存在相同物料成本记录" Then
76 'MsgBox "导入失败,请先删除该料号:" & rs!PRONUM & "再导入!!", vbCritical
77
78 '*************************************************************************************************
79 '初始化列
80 o = 0
81 For k = 1 To rs.Fields.count
82 '给Excel列赋值
83 xlsheet.Cells(j, k) = rs.Fields(o).Value '给单元格(row,col)赋值
84 '列往后进一位
85 o = o + 1
86
87 Next
88 xlsheet.Cells(j, rs.Fields.count + 1) = "存在相同物料成本记录" '给单元格(row,col)赋值
89 '行往后一步
90 j = j + 1
91 '*******************************************************************************************
92 i = i - 1
93 End If
94 Else
95 'MsgBox "导入失败,请先检查该料号:" & rs!PRONUM, , vbCritical
96 '*************************************************************************************************
97 '初始化列
98 o = 0
99 For k = 1 To rs.Fields.count
100 '给Excel列赋值
101 xlsheet.Cells(j, k) = rs.Fields(o).Value '给单元格(row,col)赋值
102 '列往后进一位
103 o = o + 1
104
105 Next
106 xlsheet.Cells(j, rs.Fields.count + 1) = "请先检查该料号" '给单元格(row,col)赋值
107 '行往后一步
108 j = j + 1
109 '*******************************************************************************************
110
111 i = i - 1
112
113
114 End If
115
116 rs.MoveNext
117 Loop
118 ConGamma.CommitTrans
119 rs.MoveFirst
120 btrans = False
121 Call UnloadInforDlg
122 If rs.RecordCount > 0 Then
123 MsgBox "共有" & i & "条记录被导入,错误信息请阅导入文件目录的Error.xls文件", vbInformation
124 End If
125 End If
126 '**********************************************
127 'xlsheet.PrintOut '打印工作表
128 Dim ssfile() As String
129 Dim ssfile2 As String
130 ssfile = Split(sFile, "\")
131 For i = 0 To UBound(ssfile) - 1
132 ssfile2 = ssfile2 & ssfile(i) & "\"
133 Next
134 ssfile2 = ssfile2 & "Error.xls"
135 xlBook.SaveAs (ssfile2)
136 xlBook.Close (True) '关闭工作簿
137 xlApp.Quit '结束EXCEL对象
138 Set xlApp = Nothing '释放xlApp对象
139 '******************************************************
140 rs.Close
141 Set rs = Nothing
142 If Trim(txtYEAR.Text) <> "" Then
143 Call frmMDI.ITMDIAdminX.ControlSearch
144 Exit Sub
145 End If
146
147 checkgetexcel:
148 MsgBox "请检查excel是否存在,excel中是否有Sheet1的工作表。(系统默认读取excel的Sheet1的工作表)", vbInformation
149 If ERR.Number <> 0 Then
150 MsgBox ERR.Description
151 End If
152
153 Exit Sub
154 End Sub
View Code
3、 导出到excel代码:
2 'Modify By KevinZhang 2014-8-22
3 '定义变量
4 Dim i, j, k, o, z As Long
5
6 Dim rs As ADODB.Recordset
7 Dim sFile As String
8 '初始化文件打开窗口
9 If txtFILE.Text <> "" Then
10 sFile = RTrim(txtFILE.Text)
11 Else '如果等于空,则关闭方法
12 MsgBox "请选择要导出的文件名", vbCritical
13 Exit Sub
14 End If
15
16 If FileExists(sFile) Then
17 If MsgBox("存在相同的档案名称,要替代吗?", vbQuestion + vbYesNoCancel) <> vbYes Then Exit Sub
18 End If
19
20 Screen.MousePointer = vbHourglass
21
22 On Error GoTo Err_Proc
23
24 '初始化循环的变量数值
25 i = 2
26 j = 1
27 '初始化Excel组建
28 Set xlApp = CreateObject("Excel.Application")
29 Set xlBook = xlApp.Workbooks.Add
30 Set xlsheet = xlBook.WorkSheets("Sheet1")
31
32 '打开选定的文件
33 'Set xlBook = xlApp.Workbooks.Open(sFile)
34 '设置其可见
35 'xlApp.Visible = True
36 '设置其工作表的名称
37 Set xlsheet = xlBook.WorkSheets("Sheet1") '设置活动工作表
38 '执行SQL连接方法,查询语句,和返回的文本
39 Set rs = ExecSQL("select * from PACKMATDTL where YEAR= '" & txtYEAR.Text & " ' AND IQUARTER='" & txtIQUARTER.Text & "'", ConGamma)
40 '循环,到数据库的总行
41
42
43 xlsheet.Cells(1, 1) = "年份" '给单元格(row,col)赋值
44 xlsheet.Cells(1, 2) = "季度" '给单元格(row,col)赋值
45 xlsheet.Cells(1, 3) = "料号" '给单元格(row,col)赋值
46 xlsheet.Cells(1, 4) = "单价" '给单元格(row,col)赋值
47
48 For z = 1 To rs.RecordCount
49 '初始化列
50 o = 0
51 For k = 1 To rs.Fields.count
52 '给Excel列赋值
53 xlsheet.Cells(i, k) = rs.Fields(o).Value '给单元格(row,col)赋值
54 '列往后进一位
55 o = o + 1
56
57 Next
58 '数据库标往后一步
59 rs.MoveNext
60 '行往后一步
61 i = i + 1
62 j = j + 1
63 Next
64 'xlsheet.PrintOut '打印工作表
65 xlBook.SaveAs (sFile)
66 xlBook.Close (True) '关闭工作簿
67 xlApp.Quit '结束EXCEL对象
68 Set xlApp = Nothing '释放xlApp对象
69 MsgBox "共有" & rs.RecordCount & "条记录被导出", vbInformation
70 rs.Close
71 Set rs = Nothing
72 Screen.MousePointer = vbDefault
73 Exit Sub
74
75
76
77 Err_Proc:
78 Screen.MousePointer = vbDefault
79 MsgBox "请确认您的电脑已安装Excel!", vbExclamation, "提示"
80
81
82
83 End Sub
View Code
有关更多的技术分享,大家可以加入我们的技术群,进行源码的分享。
欢迎加入技术分享群:238916811
转载于:https://www.cnblogs.com/bribe/p/4421311.html
VB中Excel 2010的导入导出操作相关推荐
- 循序渐进开发WinForm项目(5)--Excel数据的导入导出操作
随笔背景:在很多时候,很多入门不久的朋友都会问我:我是从其他语言转到C#开发的,有没有一些基础性的资料给我们学习学习呢,你的框架感觉一下太大了,希望有个循序渐进的教程或者视频来学习就好了. 其实也许我 ...
- Java 利用EasyPoi做Excel模板的导入导出操作
Java 利用EasyPoi做Excel模板的导入导出操作 项目背景 加入pom依赖 项目Excel模板图 代码实现 首先是实体类定义 Excel 实现导入 Excel的导出 结束语 项目背景 作为一 ...
- easyexcel导入时读不到数据_SpringBoot中EasyExcel实现Excel文件的导入导出
前言 在我们日常的开发过程中经常会使用Excel文件的形式来批量地上传下载系统数据,我们最常用的工具是Apache poi,但是如果数据到底上百万时,将会造成内存溢出的问题,那么我们怎么去实现百万数据 ...
- SQL SERVER 与ACCESS、EXCEL的数据导入导出转换
* 说明:复制表(只复制结构,源表名:a 新表名:b) select * into b from a where 1<>1 * 说明:拷贝表(拷贝数据,源表名:a 目标表名:b ...
- [导入][转]精妙的SQL和SQL SERVER 与ACCESS、EXCEL的数据导入导出转换
* 说明:复制表(只复制结构,源表名:a 新表名:b) select * into b from a where 1<>1 * 说明:拷贝表(拷贝数据,源表名:a 目标表名:b ...
- Laravel Excel实现Excel/CSV文件导入导出的功能详解(合并单元格,设置单元格样式)
Laravel Excel实现Excel/CSV文件导入导出(合并单元格,设置单元格样式) 这篇文章主要给大家介绍了关于在Laravel中如何使用Laravel Excel实现Excel/CSV文件导 ...
- ABAP 程序完成EXCEL文件的导入导出,OLE技术的应用
今天主要学习了使用微软的OLE技术,用ABAP程序完成excel文件的导入导出处理. (一)常用的OLE函数: CALL METHOD , CALL OBJECT , FREE OBJECT ...
- 前端实现excel文件的导入导出
前端实现excel文件的导入导出 导入文件 导出文件 导入文件 html: <el-dropdown v-waves @command="handleBatchCommand" ...
- docker导入MySQL文件_Docker容器中Mysql数据的导入/导出详解
前言 Mysql数据的导入导出我们都知道一个mysqldump命令就能够解决,但如果是运行在docker环境下的mysql呢? 解决办法其实还是用mysqldump命令,但是我们需要进入docker的 ...
最新文章
- git merge 和 git rebase详解
- AutoX江苏超级工厂首曝光!机械臂随处可见,车辆出厂就能完全无人驾驶
- 计算机二级python用什么书-如何准备全国计算机二级Python?
- linux c 定时器
- (转)谷歌公开dopamine
- Linux 用户名、主机添加背景色
- NYOJ88(数论)
- 如何使用Native Messaging API 打开window程序
- JavaScript escape() 函数
- C语言常用字符串函数strlen、strcpy、strcat、strcmp、strchr
- oracle安装时03113,oracle的关于“ORA-03113”的怪问题
- 51单片机用HS0038B读取遥控按键码
- C#中获得汉字的首拼音(加强版)
- C++ P1091 合唱队形[DP]
- Web前端开发项目(记忆卡片)
- 访问学者博士后面签后的几种情况?
- php商城积分兑换商品功能,帮助中心-积分商城的功能详解
- Eclipse+ GNU ARM Eclipse Plug-in+ Sourcery G++ Lite Edition for ARM+OPENCD+Jlink的开源开发环境
- 概率论与数理统计 浙江大学 第9-15讲单元测验
- 根据文件头检测文件类型的完整代码
热门文章
- log4j日志级别以及配置
- latex转为html效果好吗,latex2html
- 64位浮点数_浮点数误差
- 360压缩电脑版_震惊!360竟然出了一款这么良心的软件
- final类是否可以被代理_Java 动态代理机制分析及扩展,第 2 部分
- c语言折半排序的程序,C语言实现九大排序算法的实例代码
- 人脸验证(三)--FaceNet
- 系统学习深度学习(二十六)--BiRNN
- linux jenkins自动部署,【linux】【jenkins】自动化部署一 安装jenkins
- java getResourceAsStream方法