Question

正如标题所述，将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不太熟悉，所以我看不到任何会阻碍它的东西，尤其是因为一切仍然没有错误...

请让我知道您的想法，并在此先感谢您的帮助！

Answer 1

我觉得我不久前也见过同样的问题。也许我只是在想像而已。无论如何，F8逐行浏览代码，查看实际错误在哪里，或者考虑使用这些通用选项。

ADO：

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

DAO：

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

将Excel文件加载到Access DB

1 个答案: