String Table not being exported to excel source file

mars1985 · Apr 22, 2012

Hi, I am trying to create a module that exports data for every store ID in an Access database to individual store excel files. I have come close, so I think, to solving the problem; however, the export string table is not being allowed to export to excel. May someone help me solve my mistake please?
It is my first time writing code in VBA and am trying my best but this one has me stuck for about 4 hours now.

here is the code:

Sub exportspreadsheet()
On Error GoTo HandleError

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strSQL2 As String
Dim strFileName As String
Dim objXLApp As Object
Set objXLApp = CreateObject("Excel.Application")
Dim objXLBook As Excel.Workbook
conPath = "C:\Users\VasquezJr\Documents\"

On Error GoTo ExportReport_Error

strSQL = "Select Distinct Final_all.Store_ID From Final_all;"

Set db = CurrentDb()
Set rs = db.OpenRecordset(strSQL)
rs.MoveLast
rs.MoveFirst
Do Until rs.EOF

' create a workbook from the template
Set objXLApp = New Excel.Application
Set objXLBook = objXLApp.Workbooks.Open(conPath & "MyTemplate.xltx")

objXLBook.SaveAs (conPath & "Store_" & rs!Store_ID & "_CPC_Report.xls")
objXLBook.Close

strSQL2 = " SELECT Final_all.Store_ID, Final_all.StorePC, Final_all.FSA, Final_all.[Delivery Mode], Final_all.[Abbreviated Name], Final_all.TOTAL, Final_all.Distance_km, Final_all.MaxOfRank, Final_all.Cumm_TOT " _
& "FROM Final_all " _
& "WHERE Final_all.Store_ID =" & rs!Store_ID _
& " ORDER BY Final_all.ID, Final_all.Store_ID, Final_all.StorePC;"
strFileName = [rs]![Store_ID]

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, strSQL2, strFileName, True

rs.MoveNext
strFileName = ""
strSQL2 = ""
Set tmpLocalTable = Nothing
Set tmpLocalQuery = Nothing

Loop

On Error GoTo 0
Exit Sub

ExportReport_Error:
MsgBox "Error " & Err.Number & "(" & Err.Description & ") in procedure ExportReports"

HandleError:
Select Case Err.Number
Case 3265
Resume Next
Case 1004
Set objXLBook = objXLApp.Workbooks.Open(conPath & "Generic.xlt")
Resume Next
Case 53
Resume Next
Case 75
Resume Next
Case Else
MsgBox Err.Description, vbExclamation, _
"Error " & Err.Number
End Select
End Sub

Remou · Apr 22, 2012

You cannot use TransferSpreadsheet with an SQL string. You can set the sql of a querydef to that string and then export the query, or you can create a recordset and use automation with Excel to copy the recordset to a location in a spreadsheet:

Code:

Worksheets("Sheet3").Cells(2, 1).CopyFromRecordset rs

As an aside, you can use tags to make you code more readable :

http://www.tipmaster.com/includes/tgmlinfo.cfm?w=450&h=450

http://lessthandot.com

mars1985 · Apr 22, 2012

so would I insert that command after I have declared strSQL2? and then refer to Sheet3 as the exporting table?

Code:

Sub exportspreadsheet()
On Error GoTo HandleError

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strSQL2 As String
Dim strFileName As String
 
Dim objXLApp As Object
Set objXLApp = CreateObject("Excel.Application")
Dim objXLBook As Excel.Workbook

conPath = "C:\Users\VasquezJr\Documents\"

On Error GoTo ExportReport_Error


strSQL = "Select Distinct Final_all.Store_ID From Final_all;"
Set db = CurrentDb()
Set rs = db.OpenRecordset(strSQL)
rs.MoveLast
rs.MoveFirst
Do Until rs.EOF

      ' create a workbook from the template
       Set objXLApp = New Excel.Application
       Set objXLBook = objXLApp.Workbooks.Open(conPath & "MyTemplate.xltx")

       objXLBook.SaveAs (conPath & "Store_" & rs!Store_ID & "_CPC_Report.xls")
       objXLBook.Close


strSQL2 = " SELECT Final_all.Store_ID, Final_all.StorePC, Final_all.FSA, Final_all.[Delivery Mode], Final_all.[Abbreviated Name], Final_all.TOTAL, Final_all.Distance_km, Final_all.MaxOfRank, Final_all.Cumm_TOT " _
& "FROM Final_all " _
& "WHERE Final_all.Store_ID =" & rs!Store_ID _
& " ORDER BY Final_all.ID, Final_all.Store_ID, Final_all.StorePC;"

strFileName = [rs]![Store_ID]



DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, strSQL2, strFileName, True


rs.MoveNext
strFileName = ""
strSQL2 = ""
Set tmpLocalTable = Nothing
Set tmpLocalQuery = Nothing




Loop

On Error GoTo 0
Exit Sub

ExportReport_Error:
MsgBox "Error " & Err.Number & "(" & Err.Description & ") in procedure ExportReports"

HandleError:
    Select Case Err.Number
        Case 3265
            Resume Next
        Case 1004
            Set objXLBook = objXLApp.Workbooks.Open(conPath & "Generic.xlt")
            Resume Next
        Case 53
            Resume Next
        Case 75
            Resume Next
        Case Else
            MsgBox Err.Description, vbExclamation, _
             "Error " & Err.Number
                End Select
End Sub

Remou · Apr 22, 2012

I think you are more likely looking for a way to add your sql to a query:

Code:

qname = "MyQuery"

If IsNull(DLookup("Name", "MSysObjects", "Type=5 And Name='" & qname & "'")) Then
    CurrentDb.CreateQueryDef qname, ssql2
Else
    CurrentDb.QueryDefs(qname).sql = ssql2
End If

strFileName = [rs]![Store_ID]

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, qname, strFileName, True

http://lessthandot.com

mars1985 · Apr 22, 2012

Thank you! I have set the code as follows but now I amm getting an error saying 'Error 3129 - Invalid SQL Statement; expected 'INSERT', 'DELETE', 'UPDATE', 'PROCEDURE' or 'SELECT'

Code:

strSQL2 = "SELECT * FROM Final_all " _
& "WHERE Final_all.Store_ID =" & rs!Store_ID _
& " ORDER BY Final_all.ID, Final_all.Store_ID, Final_all.StorePC;"

qname = "MyQuery"
If IsNull(DLookup("Name", "MSysObjects", "Type=5 And Name='" & qname & "'")) Then
CurrentDb.CreateQueryDef qname, ssql2
Else
CurrentDb.QueryDefs(qname).SQL = ssql2
End If

strFileName = [rs]![Store_ID]

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, qname, strFileName, True

PHV · Apr 22, 2012

Replace the 2 ssql2 with strSQL2

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

mars1985 · Apr 22, 2012

Thanks PHV that solved that problem but now I get Error 31532, stating that Access was not able to export the data. Why would this be?

Remou · Apr 22, 2012

You now have a query called MyQuery in the database window. Open it and see if it works for you.

http://lessthandot.com

mars1985 · Apr 22, 2012

Remou, I think that MyQuery has not populated yet due to Error 31532, stating that Access was not able to export the data

Remou · Apr 22, 2012

You are exporting the query, if the query has not been created, then there is nothing to export. The code I suggested creates a query. If the query does not exist, then there is some other problem. You can set a breakpoint with F9 and when the code stops, use F8 to step through the code. The query should be created first, so you need to check that the code is running.

http://lessthandot.com

mars1985 · Apr 22, 2012

Hi Remou,

Below is how I have set the code, would it be correct to run it all or just run the query first?

Code:

Sub exportspreadsheet()
On Error GoTo HandleError

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strSQL2 As String
Dim strFileName As String
  Dim objXLApp As Object
   Set objXLApp = CreateObject("Excel.Application")
   Dim objXLBook As Excel.Workbook
   conPath = "C:\Users\VasquezJr\Documents\"



On Error GoTo ExportReport_Error

strSQL = "Select Distinct Final_all.Store_ID From Final_all;"

Set db = CurrentDb()
Set rs = db.OpenRecordset(strSQL)
rs.MoveLast
rs.MoveFirst
Do Until rs.EOF

      ' create a workbook from the template
       Set objXLApp = New Excel.Application
       Set objXLBook = objXLApp.Workbooks.Open(conPath & "MyTemplate.xltx")

       objXLBook.SaveAs (conPath & "Store_" & rs!Store_ID & "_CPC_Report.xls")
       objXLBook.Close

strSQL2 = " SELECT Final_all.Store_ID, Final_all.StorePC, Final_all.FSA, Final_all.[Delivery Mode], Final_all.[Abbreviated Name], Final_all.TOTAL, Final_all.Distance_km, Final_all.MaxOfRank, Final_all.Cumm_TOT " _
& "FROM Final_all " _
& "WHERE Final_all.Store_ID =" & rs!Store_ID _
& " ORDER BY Final_all.ID, Final_all.Store_ID, Final_all.StorePC;"

qname = "MyQuery"
If IsNull(DLookup("Name", "MSysObjects", "Type=5 And Name='" & qname & "'")) Then
CurrentDb.CreateQueryDef qname, strSQL2
Else
CurrentDb.QueryDefs(qname).SQL = strSQL2
End If

strFileName = [rs]![Store_ID]

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, qname, strFileName, True

rs.MoveNext
strFileName = ""
strSQL2 = ""
Set tmpLocalTable = Nothing
Set tmpLocalQuery = Nothing




Loop

On Error GoTo 0
Exit Sub

ExportReport_Error:
MsgBox "Error " & Err.Number & "(" & Err.Description & ") in procedure ExportReports"

HandleError:
    Select Case Err.Number
        Case 3265
            Resume Next
        Case 1004
            Set objXLBook = objXLApp.Workbooks.Open(conPath & "Generic.xlt")
            Resume Next
        Case 53
            Resume Next
        Case 75
            Resume Next
        Case Else
            MsgBox Err.Description, vbExclamation, _
             "Error " & Err.Number
                End Select
End Sub

Remou · Apr 23, 2012

As far as I can see, you have set strFilename to storeID.

This is not enough. You need a proper file name and path for your export.

http://lessthandot.com

mars1985 · Apr 24, 2012

Thanks Remou! Sorry I have not tried it as of yet I was busy with other work requests but I will try it today and hopefully fixes the errors.

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

String Table not being exported to excel source file

mars1985

Technical User

Remou

Technical User

mars1985

Technical User

Remou

Technical User

mars1985

Technical User

PHV

MIS

mars1985

Technical User

Remou

Technical User

mars1985

Technical User

Remou

Technical User

mars1985

Technical User

Remou

Technical User

mars1985

Technical User

Similar threads

Part and Inventory Search

Sponsor