VB如何将Excel中的数据批量导入到Access中？ 200
Excel表有很多张，但是格式全部统一，Access数据库只有一个。VB导入时能够先选取指定的Excel表或者选取指定文件夹中固定命名的Excel表 展开
Option Explicit
Dim data As New ADODB.Connection
Dim db As New ADODB.Recordset
Dim xlsApp As Excel.Application
Dim xlsBook As Excel.Workbook
Dim xlsSheet As Excel.Worksheet
Private Sub Command1_Click()
On Error GoTo ErrHandler
CommonDialog1.DialogTitle = "Open files"
CommonDialog1.Filter = "mdb files(*.mdb)|*.mdb"
CommonDialog1.Flags = 4 '取消 “以只读方式打开” 复选框
CommonDialog1.ShowOpen
CommonDialog1.CancelError = True
If Len(CommonDialog1.FileName) <= 4 Then
Exit Sub
Else
Text1.Text = CommonDialog1.FileName
End If
ErrHandler:
Exit Sub
End Sub
Private Sub Command2_Click()
Dim NoExistF As New FileSystemObject
Dim i, j, k As Double
'Excel行i 列j，从第二行开始，去掉标题行
i = 2
j = 1
k = 1 'Access列号，第0列留着放主键
If NoExistF.FileExists(Text1.Text) = False Or NoExistF.FileExists(Text2.Text) = False Then
MsgBox "文件不存在！", 16, "错误提示"
Exit Sub
Else
'打开Access数据库
data.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Text1.Text & ";Persist Security Info=False"
db.Open "select * From sheet", data, adOpenKeyset, adLockOptimistic '数据库表的名字sheet
'打开Excel数据表
Set xlsApp = CreateObject("Excel.Application") '创建EXCEL对象
Set xlsBook = xlsApp.Workbooks.Open(Text2.Text) '打开已经存在的EXCEL工件簿文件
Set xlsSheet = xlsBook.Worksheets("Sheet1") '设置活动工作表
Do
If xlsSheet.Cells(i, j) = "" Then '姓名=空 的时候，结束循环
Exit Do
End If
db.AddNew
db.Fields(k) = xlsSheet.Cells(i, j)
db.Fields(k + 1) = xlsSheet.Cells(i, j + 1)
db.Fields(k + 2) = xlsSheet.Cells(i, j + 2)
db.MoveNext
i = i + 1
Loop
End If
db.MovePrevious
db.Update
db.Close
data.Close
MsgBox "数据传输完毕！", , "提示"
Set xlsSheet = Nothing
xlsBook.Close
Set xlsBook = Nothing
xlsApp.Quit
Set xlsApp = Nothing
End Sub
Private Sub Command3_Click()
On Error GoTo ErrHandler
CommonDialog1.DialogTitle = "Open files"
CommonDialog1.Filter = "xls files(*.xls)|*.xls"
CommonDialog1.Flags = 4 '取消 “以只读方式打开” 复选框
CommonDialog1.ShowOpen
CommonDialog1.CancelError = True
If Len(CommonDialog1.FileName) <= 4 Then
Exit Sub
Else
Text2.Text = CommonDialog1.FileName
End If
ErrHandler:
Exit Sub
End Sub
Private Sub Form_Load()
Text1.Text = ""
Text2.Text = ""
End Sub
