求高手帮帮忙excel数据，利用VB导入到Access

83gege

求高手帮帮忙excel数据，利用VB导入到Access

感谢感谢！！！！！

新建文件夹 (2).rar (9.81 KB, 下载次数: 4)

2024-11-9 22:58 上传

点击文件名下载附件

z865593849

查收，上个问题也修改好了

hcunicom

z865593849 发表于 2024-11-10 10:18
查收，上个问题也修改好了

要是有30万行1000列 你这个循环插入要到猴年马月去洛


' 设置数据库路径
    Dim databasePath As String
    数据库文件名字 = ThisWorkbook.Sheets("参数设置").Range("B5")
    databasePath = ThisWorkbook.Path & "\" & 数据库文件名字
   
    ' 设置Excel表和Access表名
    excelTable = "汇总$" ' 使用工作表名和$符号
    accessTable = ThisWorkbook.Sheets("参数设置").Range("B6")
   
    ' 创建数据库连接对象
    Set conn = CreateObject("ADODB.Connection")
    ' 打开连接
    connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & databasePath & ";Persist Security Info=False;"
    conn.Open connectionString
   
    ' 执行SELECT INTO语句
    'sql = "select count(*) from AAA"
    'Set rst = conn.Execute(sql)
   
    Dim sql As String
    sql = "SELECT * INTO [" & accessTable & "] FROM [Excel 12.0 Xml;HDR=YES;IMEX=1;ACCDB=YES;Database=" & ThisWorkbook.FullName & "].[" & excelTable & "]"
    conn.Execute sql
   
    ' 关闭连接
    conn.Close
    Set conn = Nothing

gwjkkkkk

参与一下。。。

83gege

忘了说，我这边是excel2003，3位大哥的代码运行起来有点问题

gwjkkkkk

不知道对不对，我没有2003没办法测试。。。

83gege

gwjkkkkk 发表于 2024-11-10 17:36
不知道对不对，我没能2003没办法测试。。。

出现这个！！
另外你这好像是删除原来ACCESS里面的表，然后重新导入excel里面的数据。我想要是直接添加数据。前面的数据不删除！！！麻烦了

gwjkkkkk

83gege 发表于 2024-11-10 21:03
出现这个！！
另外你这好像是删除原来ACCESS里面的表，然后重新导入excel里面的数据。我想要是直 ...

不会了，期待高手。。。

83gege

谢谢大家！！！小弟用AI写成功了

Sub ImportDataToAccess()
    Dim conn As Object
    Dim rs As Object
    Dim strFile As String
    Dim strConn As String
    Dim strSQL As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rngData As Range
    Dim row As Range

    ' 设置Access数据库文件路径
    strFile = "d:\ABC.mdb"

    ' 设置连接字符串
    strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";"

    ' 创建ADODB连接对象
    Set conn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")

    ' 打开连接
    On Error GoTo ErrorHandler
    conn.Open strConn

    ' 设置Excel工作簿和工作表
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")

    ' 设置要导入的数据范围
    Set rngData = ws.Range("B2:D" & ws.Cells(ws.Rows.Count, "A").End(xlUp).row)

    ' 循环遍历数据并将其插入到Access数据库中
    For Each row In rngData.Rows
        ' 创建SQL语句
        strSQL = "INSERT INTO mei (名称, 价格, 日期) VALUES ('" & row.Cells(1).Value & "', " & row.Cells(2).Value & ", #" & Format(row.Cells(3).Value, "yyyy-mm-dd") & "#)"
        
        ' 执行SQL语句
        conn.Execute strSQL
    Next row

    ' 关闭连接并释放对象
    conn.Close
    Set conn = Nothing
    Set rs = Nothing

    MsgBox "数据导入成功！"
    Exit Sub

ErrorHandler:
    MsgBox "发生错误: " & Err.Description, vbCritical, "错误"
    If Not conn Is Nothing Then
        If conn.State = 1 Then conn.Close
    End If
    Set conn = Nothing
    Set rs = Nothing
End Sub

83gege

谢谢大家，小弟用AI写出来的，能满足要求了