Excel VBA to Export Data to MS Access Table - Extended

Question

I'm trying to use the method that was described in one of the other threads that I saw posted on stackoverflow here.

When using the method that was described in that thread (that got the green check) I'm getting an error when running the code. The error pop-ups up a blank message box with no contents.

A couple of things to mention:

(1) I've made sure to select and activate the Microsoft Access 14.0 Object Library in Excel.

(2) I am running the sub procedure from my database worksheet in Excel.

(3) I am then running the AccImport procedure within my code procedure from my wizard worksheet in Excel (separate worksheet).

EXCEL SPREADSHEET SETUP

I can't use screenshots as of yet as I am new to the community but the database worksheet field range is setup as follows.

B1 (Occurrence Date), C1 (Machine), D2 (Cell), E2 (Status), F2 (Issue), G2(Preventative/Corrective), H2 (Assigned To)

B2 (15-APR-2015), C2(machine1), D2(cell1), E2 (0), F2(Test), G2 (Corrective), H2 (nameexample1)

ACCESS DATABASE TABLE IS SETUP AS FOLLOWS:

Table Name: MaintenanceDatabase

ID, Occurrence Date, Machine, Cell, Status, Issue, Preventative/Corrective Assigned To

Here is the code that I am running from the Database worksheet in 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

Code Snippet from other Worksheet Object that Runs 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

Hopefully someone could shed some light into why I'm getting an error.

Thanks in advance for any help.

Cheers,

Brad

score 0 · Answer 1 · answered Apr 20 '15 at 19:58

I've never tried writing from excel to access in the way you've mentioned. Below is my preferred method. You'll need to use the Microsoft DAO object library but using a DAO object you can do updates, inserts, pulls, pretty much whatever you need to accomplish.

 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

Excel VBA to Export Data to MS Access Table - Extended

1 Answers1