用vb6导入excel工作表内容,疑问
我用VB6,导入excel2003的文件,一般的excel文件好象都没问题,遇到有宏的出错.我导入用的代码是:
Private Function FunImpExcel(ByVal strFilePath As String) As Integer
'Excel文件格式
'第一行为表名,第二行为列名,其余行均为数据
On Error GoTo hErr
Dim objConn As New ADODB.Connection
Dim objRS As New ADODB.Recordset
If Dir(strFilePath) = "" Then
MsgBox "文件不存在", vbCritical, "错误"
Exit Function
End If
'定义Excel对象
Dim xlsApp As Object
Dim xlsWb As Object
Dim xlsWs As Object
Set xlsApp = CreateObject("Excel.Application") '建立excel对象
Set xlsWb = xlsApp.Workbooks.Open(strFilePath) '要打开的文档路径
Set xlsWs = xlsWb.Worksheets(2) '选工作表,有多张表时,可以参考此,变换序号指定不同的表
xlsWs.Activate
xlsApp.Visible = False '隐藏,否则会在界面显示出来
'Excel表格的行数和列数
Dim iRowCnt As Integer
Dim iColCnt As Integer
iRowCnt = xlsWs.UsedRange.Rows.Count '出错的代码,我把excel文件附加上,帮我分析一下原因 iColCnt = xlsWs.UsedRange.Columns.Count '
'下面要根据具体的表格情况决定,这里前面两行是表名和列名
If iRowCnt <= 2 Then
MsgBox "没有需要导入的明细数据", vbCritical, "错误"
GoTo hErr
End If
'从第3行开始是明细数据
For i = 2 To iRowCnt
'设置退出条件
If Trim$(xlsWs.Cells(i, 3).Value) = "" Then
mdlPub.debug_print "on date found anymore:" & i
Exit For
End If
'第一条数据时,先打开数据库,这里是access
If 3 = i Then
'数据库访问操作可以封装成一个公共的函数或过程
Dim strConn As String
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=true;Data Source=test.mdb"
objConn.CursorLocation = adUseClient
objConn.Open strConn
strSQL = "select * from [要导入的表名] where 1=2 "
objRS.CursorLocation = adUseClient
objRS.Open strSQL, objConn, adOpenKeyset, adLockOptimistic
End If
'新增一条记录,注意各个字段的数据类型匹配问题,
'最好全部统一先转化为字符串,再转化为对应的类型
objRS.AddNew
objRS.Fields("数据库列名1") = Trim(CStr(xlsWs.Cells(i, 1).Value))
objRS.Fields("数据库列名2") = Trim(CStr(xlsWs.Cells(i, 2).Value))
'.....
objRS.Fields("数据库列名n") = CLng(Trim(CStr(xlsWs.Cells(i, n).Value)))
'如果Excel列名与要导入的数据库列能按顺序一一对应,
'则可以按以下方式,但要解决不同字段的数据格式匹配问题,比较麻烦
'For j = 0 To RS.Fields.Count - 1
' RS.Fields(j) = Trim(CStr(xlsWs.Cells(i, 1).Value))
'Next
'更新到数据库
objRS.Update
Next i
objRS.Close
objConn.Close
Set objRS = Nothing
Set objConn = Nothing
xlsWb.Close '关闭excel文件
xlsApp.Quit '退出excel
Set xlsWs = Nothing
Set xlsWb = Nothing
Set xlsApp = Nothing
FunImpExcel = 0 '成功则返回0
Exit Function
hErr:
ImpExcelCertDtl = -1 '失败则返回1
If Not (xlsWb Is Nothing) Then xlsWb.Close '关闭文件
If Not (xlsApp Is Nothing) Then xlsApp.Quit
Set xlsWs = Nothing
Set xlsWb = Nothing
Set xlsApp = Nothing
MsgBox "文件导入失败", vbCritical, "错误"
End Function
有从事过这方面工作的,QQ联系:64847806
[解决办法]
你的电子表格文件我试了,代码是出现了错误。
你的电子表格是怎么生成的?可以肯定不是手动生成的,在测试时,iRowCnt = xlsWs.UsedRange.Rows.Count 返加的行是65535,可是我看到的是从515行以后就没有数据了。
你在程序中iRowCnt应当定义为long因为电子表格的最后一行是65536,代码的错误原因就在于此。但我不清楚的是从515行以后就没有数据,但用 xlsWs.UsedRange.Rows.Count返回值克是65535?
解决方法:
1、iRowCnt应当定义为long型
2、将1到514行复制到其它工作表中或用宏删除515至65535行内容。