Question

VB如何将Excel中的数据批量导入到Access中？

Excel中有一份人员信息名单，想通过VB来将信息批量导入至Access中。举例，Excel中有姓名、性别、年龄三列信息（excel中的单元格A列、B列、C列分别对应姓名、性别、年龄，从A2、B2、C2开始为所需导入的内容，A1、B1、C1用来标注姓名、性别、年龄），将这些信息批量导入至Access表1对应名称的字段中（姓名、性别、年龄）。思路是什么？代码如何写?求大神帮助。
Excel表有很多张，但是格式全部统一，Access数据库只有一个。VB导入时能够先选取指定的Excel表或者选取指定文件夹中固定命名的Excel表





Answer 1

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

Answer 2

Access数据表有主键吗？

需要私信我

Answer 3

我可以帮你写