首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

用vb6导入excel工作表内容,疑义

2013-08-09 
用vb6导入excel工作表内容,疑问我用VB6,导入excel2003的文件,一般的excel文件好象都没问题,遇到有宏的出错

用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行内容。

热点排行