Excel Run Access Docmd.TransferSpreadsheet into activeworkbook

[healey21]

I have been asked to use a query in Access and return the results into ThisWorkbook.FullName where the code resides. I am not permitted to use the Get External Data option in Excel due to business reasons. I have the references set for Microsoft Access. I get an Error 3275, and highlights the DoCmd Line.

The code I am trying to use is as follows:

Sub openaccess2()
Dim appAcc As New Access.Application
Const path As String = "L:\PassToExcel.mdb"
With appAcc
    .opencurrentdatabase path
    .DoCmd.SetWarnings False
    .DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "qryData", ThisWorkbook.FullName, True
    .DoCmd.SetWarnings True
    .Visible = True
End With
appAcc.Quit
appAcc Nothing

End Sub

 

[gaj104]

Your code is opening access, then exporting a query to an excel file. The name of that excel file is the one you currently have open, so it can't overwrite this. Either change the name of the workbook to save to, or if you want the data to go into the current workbook then open a recordset and write the data to a specific sheet.

ie.

'Add Microsoft DAO in references

Sub openaccess2()
Dim appAcc As New Access.Application
Dim rs As DAO.Recordset
Dim ws As Worksheet
Dim i As Long

Const path As String = "L:\PassToExcel.mdb"

Set ws = ThisWorkbook.Sheets("Data") 'Rename as required

With appAcc
    .opencurrentdatabase path
    
    Set rs = .CurrentDb.OpenRecordset("SELECT * FROM qryData")
    
    For i = 0 To rs.Fields.Count - 1
    
        ws.Cells(1, i + 1).Value = rs.Fields(i).Name
    
    Next i
    
    ws.Range("A2").CopyFromRecordset rs

End With

appAcc.Quit

Set appAcc = Nothing

End Sub

 

[Trevor G]

You can also try this code out.

Sub openaccess2()
'Add the reference for MS Access and Microsoft DAO
'GoTo Tools References search down the list for Microsoft Access XX.Object Library
'Tick the box and do the same for Microsoft DAO XX.Object Library
Dim db As DAO.Database
Dim ws As Worksheet
Dim rst As DAO.Recordset
Dim lngCount As Long
Dim i As Long
Set db = OpenDatabase("L:\PassToExcel.mdb")
Set rst = db.OpenRecordset("qryData")
Set ws = Sheets(1)
lngCount = 1
For i = 0 To rst.Fields.Count - 1
ws.Range("a2").Offset(0, i).Value = rst.Fields(i).Name
Next
Do Until rst.EOF
    With ws
         .Cells(lngCount + 1, 1).Value = rst!Title 'These are the field names, adjust to yours
         .Cells(lngCount + 1, 2).Value = rst!Firstname
         .Cells(lngCount + 1, 3).Value = rst!Lastname
         .Cells(lngCount + 1, 4).Value = rst!JobTitle
         .Cells(lngCount + 1, 5).Value = rst!BirthDate
         .Cells(lngCount + 1, 6).Value = rst!Gender
         .Cells(lngCount + 1, 7).Value = rst!Office
         .Cells(lngCount + 1, 8).Value = rst!Department
         .Cells(lngCount + 1, 9).Value = rst!Email
        .Cells(lngCount + 1, 10).Value = rst!Salary
    End With
    lngCount = lngCount + 1
    rst.MoveNext
Loop
rst.Close
Set rst = Nothing
End Sub

 

[healey21]

Gaj104 and Trevor thank you for both suggestions they both work a treat. I can close this thread now.