vb将excel导入access

Question

如题所述

Answer 1

以前写的一段代码，希望对你有用（VB6+ACCESS2003+EXCEL2003）。
需要先引用EXCEL库,2003对应版本号11。自己处理下rst的打开以及使用的字段。
Private Function ImportFromExcel(excelFile As String) As Long
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim rst As New ADODB.Recordset
Dim nCount As Long, strCardNo As String

On Error GoTo errH

Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Open(excelFile) '打开EXCEL文件
Set xlSheet = xlBook.Sheets(1) '打开第一页（sheet）

ImportFromExcel = 0

'打开数据库
rst.Open "...", pConn, adOpenKeyset, adLockOptimistic, adCmdText

'开始导入。导入过程检查数据是否有重复。
nCount = 1
Do
strCardNo = Trim(xlSheet.Cells(nCount, 1))
'这里根据第一列数据为空判断记录结束
If Len(strCardNo) = 0 Then
ImportFromExcel = nCount - 1
Exit Do
End If
If Not rst.EOF Then rst.Find ("STCardNO='" & strCardNo & "'")
If rst.EOF Then
rst.AddNew
rst("STCardNO") = Format(strCardNo, "0000000000")
...
rst.Update

Else
If MsgBox("卡号：" & strCardNo & " 已经存在。" & vbCrLf & "选择“重试”将忽略并继续导入余下的数据，“取消”将放弃导入。", vbExclamation + vbRetryCancel + vbDefaultButton2, "卡号重复") = vbCancel Then
ImportFromExcel = nCount - 1
Exit Do
End If
End If
nCount = nCount + 1
ImportFromExcel =nCount
Loop

'销毁对象释放资源
rst.Close
Set rst = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing

xlApp.Quit '关闭Excel
Set xlApp = Nothing
Exit Function

errH:
ImportFromExcel = -1
End Function本回答被提问者和网友采纳

Answer 2

什么东西？