Excel VBA для экспорта данных в таблицу доступа MS - Extended

Question

Я пытаюсь использовать метод, описанный в одном из других потоков, который я видел в потоке stackoverflow here.

При использовании метода, описанного в этом потоке (который получил зеленый чек), я получаю сообщение об ошибке при запуске кода. Ошибка выдает пустое поле сообщения без содержимого.

Несколько вещей упомянуть:

(1) Я удостоверился, чтобы выбрать и активировать библиотеку объектов Microsoft Access 14.0 в Excel.

(2) Я выполняю подпроцедуру из моей рабочей таблицы базы данных в Excel.

(3) Затем я запускаю процедуру AccImport в своей процедуре кода на своем рабочем листе мастера в Excel (отдельный рабочий лист).

---

EXCEL Вычислитель НАСТРОЙКА

Я не могу использовать скриншоты как еще, как я новичок в сообществе, но диапазон рабочего листа поле базы данных настройки следующим образом.

В1 (Встречаемость Дата), С1 (машина), D2 (сотовый), Е2 (статус), F2 (выпуск), G2 (Профилактический/Корректирующий), Н2 (Назначен)

В2 (15- апрель-2015), С2 (machine1), D2 (cell1), Е2 (0), F2 (тест), G2 (Корректирующее), Н2 (nameexample1)

---

доступа к базам данных этой таблицы НАСТРОЙКА нижеследующем:

Наименование таблицы: MaintenanceDatabase

ID, Происшествие Дата, машина, сотовый, состояние, Issue, Профилактическое/Корректирующее Назначено

Вот код, который я бегу из базы данных листа в 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

Я никогда не пытался писать от первенствует, чтобы получить доступ, как вы уже упоминали. Ниже мой предпочтительный метод. Вам нужно будет использовать библиотеку объектов 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