时间戳

首页 > 解决方案 > 将excel文件加载到Access DB

excel - 将excel文件加载到Access DB

问题描述

正如标题所述，我在将 Excel 工作表加载到 Access DB 时遇到了一些问题。长话短说 - 开始了一项新工作，该工作使用 Excel 报告提取数据，对其进行重组，然后每天将其加载到数据库中。然后使用该数据库生成季度报告。在我尝试生成季度末报告并停止加载之前，它在第一个月将每日数据加载到数据库中工作得非常好。宏仍然运行良好，没有错误，但每日数据不再加载到数据库中。

这是代码：

Sub LoadData()

Dim ADOConn As New ADODB.Connection
Dim ADORecSet As New ADODB.Recordset
Dim DBName As String
Dim TradeDate As Date

Set ws = ActiveWorkbook.Sheets("Load")
ws.Calculate

If Range("B2").Value = "" Then
 MsgBox "Please Enter Report Date"
Else

DBName = "\\spco1cfm1\Data\BONDESK\Hit Rate Report\Client_HitRate.accdb"

With ADOConn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .Open DBName
End With

'Assigning Trade Date

TradeDate = ws.Range("TradeDate")
TradeDate = Format(TradeDate, "mm/dd/yyyy")
NumClients = ws.Range("NumClients")

ADORecSet.Open "tblCDClientProducts", ADOConn, adOpenKeyset, adLockOptimistic
nfields = ADORecSet.Fields.Count

For t = 1 To NumClients

ADORecSet.AddNew

' Inputs Data to Access Database

ADORecSet(0) = TradeDate & "_" & ws.Cells(t + 5, 1) & "_" & ws.Cells(t + 5, 2)
ADORecSet(1) = TradeDate
ADORecSet(2) = ws.Cells(t + 5, 1)
ADORecSet(3) = ws.Cells(t + 5, 2)
ADORecSet(4) = ws.Cells(t + 5, 3)
ADORecSet(5) = ws.Cells(t + 5, 4)
ADORecSet(6) = ws.Cells(t + 5, 6)
ADORecSet(7) = ws.Cells(t + 5, 9)
ADORecSet(8) = ws.Cells(t + 5, 12)
If ws.Cells(t + 5, 18).Value = "" Then
    ADORecSet(9) = 0
Else
    ADORecSet(9) = ws.Cells(t + 5, 18)
End If
ADORecSet(10) = ws.Cells(t + 5, 19)
ADORecSet(11) = ws.Cells(t + 5, 22)
ADORecSet(12) = ws.Cells(t + 5, 23)
ADORecSet(13) = ws.Cells(t + 5, 25)

'Updates the Access Database

ADORecSet.Update

Next t

'Ends connection with access

ADORecSet.Close
ADOConn.Close

End If

 End Sub

不幸的是，我对 VBA 不太熟悉，所以我没有注意到任何会阻碍它的东西，特别是因为一切仍然运行无错误......

请让我知道您的想法，并提前感谢您的帮助！

标签： exceldatabasevbams-access

解决方案

我觉得我不久前也看到过同样的问题。也许我只是在想象它。不管怎样，F8 通过代码，一行一行，看看实际错误在哪里，或者考虑这些通用选项。

阿多：

Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
    ' connect to the Access database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=C:\FolderName\DataBaseName.mdb;"
    ' open a recordset
    Set rs = New ADODB.Recordset
    rs.Open "TableName", cn, adOpenKeyset, adLockOptimistic, adCmdTable  
    ' all records in a table
    r = 3 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0 
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("FieldName1") = Range("A" & r).Value
            .Fields("FieldName2") = Range("B" & r).Value
            .Fields("FieldNameN") = Range("C" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

道：

Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
    Set db = OpenDatabase("C:\FolderName\DataBaseName.mdb") 
    ' open the database
    Set rs = db.OpenRecordset("TableName", dbOpenTable) 
    ' get all records in a table
    r = 3 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0 
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("FieldName1") = Range("A" & r).Value
            .Fields("FieldName2") = Range("B" & r).Value
            .Fields("FieldNameN") = Range("C" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
End Sub

推荐阅读