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!

Register Log in
  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

String Table not being exported to excel source file

Status
Not open for further replies.
mars1985

mars1985

Technical User
Apr 21, 2012
7
CA
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
 
Sort by date Sort by votes
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 :
 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
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




 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
Replace the 2 ssql2 with strSQL2

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Upvote 0 Downvote
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?
 
Upvote 0 Downvote
Remou, I think that MyQuery has not populated yet due to Error 31532, stating that Access was not able to export the data
 
Upvote 0 Downvote
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.

 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
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.

 
Upvote 0 Downvote
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.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Viswa.R
  • Locked
  • Question
Dimension import from Autocad to Excel
Replies
0
Views
184
Viswa.R
Viswa.R
FrankMars
  • Locked
  • Question
Exporting Records to Excel 1
Replies
6
Views
261
Andrzejek
Andrzejek
JimStrand
  • Locked
  • Question
Trying to Use Form Control as Variable in Report Control Source 2
Replies
5
Views
273
Andrzejek
Andrzejek
renigar
  • Locked
  • Question
Code to write file path to field always writes to 1st record 1
Replies
5
Views
250
dhookom
dhookom
Moss100
  • Locked
  • Question
Remove everything including the comma from the last comma of a string. 1
Replies
10
Views
348
Andrzejek
Andrzejek

Part and Inventory Search

Sponsor

Back
Top