Excel VBA將數據導出到MS Access表-擴展

Question

我正在嘗試使用在此處我在stackoverflow上看到的其他線程之一中描述的方法。

當使用該線程中描述的方法（帶有綠色標記）時，運行代碼時出現錯誤。 該錯誤會彈出一個沒有內容的空白消息框。

有兩件事要提到：

（1）我已經確保選擇並激活Excel中的Microsoft Access 14.0對象庫。

（2）我正在從Excel中的數據庫工作表中運行子過程。

（3）然后，我從Excel的向導工作表（單獨的工作表）中的代碼過程中運行AccImport過程。

---

出色的電子表格設置

由於我是社區的新手，到目前為止我還無法使用屏幕截圖，但是數據庫工作表字段范圍的設置如下。

B1（發生日期），C1（機器），D2（單元），E2（狀態），F2（問題），G2（預防/糾正），H2（指派給）

B2（2015年4月15日），C2（機器1），D2（單元格1），E2（0），F2（測試），G2（糾正），H2（名稱示例1）

---

訪問數據庫表的設置如下：

表名稱：MaintenanceDatabase

ID，發生日期，機器，單元格，狀態，問題，分配給的預防/糾正措施

這是我從Excel中的數據庫工作表運行的代碼：

Sub AccImport()

    Dim acc As New Access.Application
    acc.OpenCurrentDatabase "C:\Users\brad.edgar\Desktop\DASHBOARDS\MAINTENANCE\MaintenanceDatbase.accdb"
    acc.DoCmd.TransferSpreadsheet _
        TransferType:=acImport, _
        SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
        TableName:="MaintenanceDatabase", _
        Filename:=Application.ActiveWorkbook.FullName, _
        HasFieldNames:=True, _
        Range:="Database$B1:H2"
    acc.CloseCurrentDatabase
    acc.Quit
    Set acc = Nothing

End Sub

來自運行AccImport的其他工作表對象的代碼片段：

Public Sub DeleteSelectedRecord()
    Dim CurrentSelectedIndex    As Integer

    ' Assign the currently selected index to CurrentSelectedIndex
    CurrentSelectedIndex = [Database.CurrentIndex]

    ' Move the ListBox Selector
    If [Database.CurrentIndex].Value = [Database.RecordCount] Then    
'Last item on the list
        [Database.CurrentIndex].Value = [Database.CurrentIndex].Value - 1
    End If

    'Copy to Access Database

    Database.AccImport

    ' Delete the entry
    Database.ListObjects("Database").ListRows(CurrentSelectedIndex).Delete

End Sub

希望有人可以闡明為什么我出錯了。

在此先感謝您的幫助。

干杯，

布拉德

Answer 1

我從未嘗試按照您提到的方式從excel編寫訪問權限。 下面是我的首選方法。 您將需要使用Microsoft DAO對象庫，但是使用DAO對象，您可以執行更新，插入，提取等幾乎所有您需要完成的工作。

 Sub SaveCustomer_Defaults()

 Dim strSQL As Variant
 Dim accApp As Object
 Dim srcs As Variant
 Dim msg1 As Variant

 Sheets("Lists").Visible = True
 Sheets("Lists").Select
     Range("T6").Select
     x = Range("T500000").End(xlUp).Row

 For i = 6 To x
     Cells(i, 20).Select
     If Environ("USERNAME") = Cells(i, 23).Value Then
      'location of the access db   
      srcs = "C:\\user\desktop\Detail_1.accdb"  ''' Live location '''

    Set accApp = GetObject(srcs, "access.Application")

    'write your sql to pull the table along with the cell values
    strSQL = "Select * from US_CustomID "
    strSQL = strSQL & " where( [AssignedTo] = '" & Sheets("Lists").Cells(i, 21)
    strSQL = strSQL & "' and [Tab] = '" & Sheets("Lists").Cells(i, 24)
    strSQL = strSQL & "' and [RepID] = '" & Sheets("Lists").Cells(i, 23)
    strSQL = strSQL & "');"

    Set db = DAO.OpenDatabase(srcs)
    Set rs = db.OpenRecordset(strSQL)

    On Error Resume Next
    rs.Edit


    rs![Occurrence Date] = Sheets("Lists").Cells(i, 25)
    rs![Machine] = Sheets("Lists").Cells(i, 26)
    rs![Cell] = Sheets("Lists").Cells(i, 27)
    rs![Status] = Sheets("Lists").Cells(i, 28)
    rs![Issue] = Sheets("Lists").Cells(i, 29)
    rs![Preventative/Corrective] = Sheets("Lists").Cells(i, 30)
    rs![Assigned To] = Sheets("Lists").Cells(i, 31)

    rs.Update

    If Not rs Is Nothing Then rs.Close

    Set rs = Nothing
    Set db = Nothing

    accApp.DoCmd.RunSQL strSQL
    accApp.Application.Quit
        End If
    Next i

    Sheets("Lists").Visible = False

    End Sub