ms Access export to excel

[sparkbyte]

I have a menu button that creates a table with all UPS tracking numbers parsed so that an export can be created based on the shipping method.

Here is the code I have been trying to get running.
The SQL querie works in SQL manager.

Dim strSQL As String
Dim strSQL1 As String
Dim strSQL2 As String
Dim strSQL3 As String
Dim strFileName As String

strSQL1 = "SELECT BoxNumber, FileNumber, TrackingDate, TrackingNumberPrefix, TrackingNumberAct, TrackingNumberShipping, TrackingNumberParsel"
strSQL2 = "FROM dbo.tblTrackingParse"
strSQL3 = "WHERE FileNumber <> '.box.end.') AND (BoxNumber NOT LIKE 'NBC%') AND (LEN(BoxNumber) < '30') AND (TrackingNumberPrefix LIKE '1Z')"
strSQL = strSQL1 & " " & strSQL2 & " " & strSQL3

'Debug.Print strSQL

strFileName = "c:\test.xls"

'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strSQL, strFileName, True, "Shipping Report"

Thanks

John Fuhrman

 

[PWise]

the TableName arugerment of TransferSpreadsheet dose not take a SQL Statement create a select query with your select statement

 

[randy700]

You don't state any problem, but this may help.

BoxNumber NOT LIKE 'NBC[b][COLOR=red]*[/color][/b]'

Randy

 

[sparkbyte]

Seems that the DoCmd.TransferSpreadsheet method cannot take the strSQL string input.

I can put in a table name and it works just fine. But i need it to use a view. (query)

Like this.

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "dbo.View_ParseUPSTrackingNumbers", strFileName, True, "Shipping Report"

But I get an error 7874 when trying to use the query.


Thanks

John Fuhrman

 

[randy700]

Post the query SQL.

Randy

 

[sparkbyte]

SELECT BoxNumber, FileNumber, TrackingDate, TrackingNumberPrefix, TrackingNumberAct, TrackingNumberShipping, TrackingNumberParsel
FROM dbo.tblTrackingParse
WHERE (FileNumber <> '.box.end.') AND (BoxNumber NOT LIKE 'NBC%') AND (LEN(BoxNumber) < '30') AND (TrackingNumberPrefix LIKE '1Z')




Thanks

John Fuhrman

 

[randy700]

Read my post from 11 May 10 13:58 .
You need to use the proper wild card symbol.

Randy

 

[randy700]

Also, LEN(BoxNumber) should be a number.
Try removing the single quotes around the 30.

Randy

 

[sparkbyte]

I am using the correct symbol. (I think) This is an ADP with a backend of SQL Server 2005.

Thanks

John Fuhrman

 

[Golom]

If you want the TransferSpreadsheet argument to be a query rather than a table then create a query

Dim db          As DAO.Database
Dim strSQL      As String
Dim strFileName As String

strFileName = "c:\test.xls"

strSQL  = "SELECT BoxNumber, FileNumber, TrackingDate, TrackingNumberPrefix, " & _
                  TrackingNumberAct, TrackingNumberShipping, TrackingNumberParsel " & _
          "FROM dbo.tblTrackingParse " & _
          "WHERE FileNumber <> '.box.end.' " & _
             AND BoxNumber NOT LIKE 'NBC*' " & _
             AND Len(BoxNumber) < 30 " & _
             AND TrackingNumberPrefix LIKE '1Z'"

Set db = Currentdb()

db.CreateQueryDef("myQuery", strSQL)

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                          myQuery, strFileName, True, "Shipping Report"

 

[PWise]

sorry john

len() returns an interger quotes changes the 30 to a string

 

[sparkbyte]

Golom, I am getting a sytax error on

db.CreateQueryDef("myQuery", strSQL)

Not sure why.


Thanks

John Fuhrman

 

[Golom]

Sorry. Didn't test it. You may need

db.CreateQueryDef "myQuery", strSQL

 

[sparkbyte]

An unexpected error has been detected

Description is: 91 , Object variable or With block variable not set

Private Sub btnExporttoExcel_Click()
On Error GoTo err_handler

'------------------------------------------------------
'------------------------------------------------------
' Export New Table to Excel
'------------------------------------------------------
'------------------------------------------------------


Dim db          As DAO.Database
Dim strSQL      As String
Dim strFileName As String

strFileName = "c:\test.xls"

strSQL = "SELECT BoxNumber, FileNumber, TrackingDate, TrackingNumberPrefix, " & _
            "TrackingNumberAct, TrackingNumberShipping, TrackingNumberParsel " & _
            "FROM dbo.tblTrackingParse " & _
            "WHERE FileNumber <> '.box.end.' " & _
            "AND BoxNumber NOT LIKE 'NBC%' " & _
            "AND Len(BoxNumber) < 30 " & _
            "AND TrackingNumberPrefix LIKE '1Z'"

Debug.Print strSQL

Set db = CurrentDb()
'db.CreateQueryDef("dbo.myQuery", strSQL)
db.CreateQueryDef "myQuery", strSQL
db.Close


DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                          myQuery, strFileName, True, "Shipping Report"

endit:
Exit Sub

err_handler:
    Select Case Err
        Case 2501
            'Do Nothing
        Case Else
            MsgBox _
            "An unexpected error has been detected" & Chr(13) & _
            "Description is: " & Err.Number & " , " & Err.Description & Chr(13) & _
            vbCrLf & "Please note the above details before contacting support"
    End Select
Resume endit
End Sub

SELECT BoxNumber, FileNumber, TrackingDate, TrackingNumberPrefix, TrackingNumberAct, TrackingNumberShipping, TrackingNumberParsel FROM dbo.tblTrackingParse WHERE FileNumber <> '.box.end.' AND BoxNumber NOT LIKE 'NBC%' AND Len(BoxNumber) < 30 AND TrackingNumberPrefix LIKE '1Z'

The debug.print cut and pasted into query manager works with no mods.



Thanks

John Fuhrman

 

[PWise]

john you are createing a jet database query
you need a passtruh query

 

[PHV]

Anyway:
[!]"[/!]myQuery[!]"[/!], strFileName, ...

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

 

[sparkbyte]

OK, I've done some reading and follow most of the steps but they all include a connect string that requires a DSN on the workstation. With an ADP I don't think the connect string should be needed. How would I do a pass-through for an ADP back-ended to MS SQL Server 2005?

here is an example

Sub passthrough_query_test()
Dim dbs As Database
Dim qdfPassThrough As QueryDef
Dim qdfTemp As QueryDef

Set dbs = CurrentDb()

Set qdfPassThrough = dbs.CreateQueryDef("ShortCodes")

qdfPassThrough.Connect = _
"ODBC;DSN=OMPUBLIC;UID=OMPUBLIC;PWD=ompublic;DBQ=PROD ;DBA=W;APA=T;EXC=F;FEN=T;QTO=T;FRC=10;FDL=10;LOB=T;RST=T;BTD=F;BNF=F;BAM=IfAllSuccessful;NUM=NLS;DPM=F;MTS=T;MDI=F;CSR=F ;FWC=F;FBS=64000;TLO=O;"

qdfPassThrough.SQL = "SELECT ticket_id, short_code FROM vw_billing_transaction WHERE ticket_id IN ('21089-0215K-1708C-03WG1','2108C-02113-2004Q-02YTD','2108A-0211H-19576-03PQ7','21081-0215K-17407-03JJM');"

qdfPassThrough.ReturnsRecords = True

With dbs
Set qdfTemp = .CreateQueryDef("tmpTable", "SELECT * from ShortCodes")
DoCmd.OpenQuery "tmpTable"
.QueryDefs.Delete "tmpTable"
End With

dbs.QueryDefs.Delete "ShortCodes"
dbs.Close

End Sub

or from MS

http://support.microsoft.com/kb/304323

Thanks for everyone's assistance!!

Thanks

John Fuhrman

 

[PWise]

for an adp it would not be a pass trou it would be a view in the Sql Database

there are many ways to skin a cat

what i would do in your case is open a adodb.recordset with you sql

open an excell workbook and use the copy from recordset method
Dim exCellApp As Excel.Application
Set exCellApp = CreateObject("Excel.Application")
exCellApp.Workbooks.Add
exCellApp.Worksheets(1).Range("a2").CopyFromRecordset recordset name
exCellApp.ActiveWorkbook.SaveAs FileName
exCellApp.ActiveWorkbook.Saved = True
exCellApp.Quit

 

[sparkbyte]

What about builing a SSIS package for the export the having Access execute the SSIS export package?

Thanks

John Fuhrman

 

[sparkbyte]

Well found this example and tried to modify it.

I am getting "error 91: Object variable or With block variable not set" and can't seem to correct it.

Private Sub btnExportAutomation_Click()
On Error GoTo err_Handler
   
   MsgBox ExportRequest, vbInformation, "Finished"
   Application.FollowHyperlink CurrentProject.Path & "\Output.xls"

endit:
Exit Sub

err_Handler:
    Select Case Err
        Case 2501
            'Do Nothing
        Case Else
            MsgBox _
            "An unexpected error has been detected" & Chr(13) & _
            "Error Number: " & Err.Number & " , " & Err.Description & Chr(13) & _
            vbCrLf & "Please note the above details before contacting support"
    End Select
Resume endit
End Sub

Public Function ExportRequest() As String
On Error GoTo err_Handler
   
   ' Excel object variables
   Dim appExcel As Excel.Application
   Dim wbk As Excel.Workbook
   Dim wks As Excel.Worksheet

   Dim sTemplate As String
   Dim sTempFile As String
   Dim sOutput As String
   
   Dim dbs As DAO.Database
   Dim rst As DAO.Recordset
   Dim sSQL As String
   Dim lRecords As Long
   Dim iRow As Integer
   Dim iCol As Integer
   Dim iFld As Integer
   
   Const cTabTwo As Byte = 2
   Const cStartRow As Byte = 4
   Const cStartColumn As Byte = 3
   
'   DoCmd.Hourglass True
   
   ' set to break on all errors
   Application.SetOption "Error Trapping", 0
   
   ' start with a clean file built from the template file
   sTemplate = CurrentProject.Path & "\Template.xls"
   sOutput = CurrentProject.Path & "\Output.xls"
   If Dir(sOutput) <> "" Then Kill sOutput
   FileCopy sTemplate, sOutput
   
   ' Create the Excel Applicaiton, Workbook and Worksheet and Database object
   Set appExcel = Excel.Application
   Set wbk = appExcel.Workbooks.Open(sOutput)
   Set wks = appExcel.Worksheets(cTabTwo)

      
'   sSQL = "select Top(50) * from tblTrackingParse"
   
   
    sSQL = "SELECT TOP (50) Tracking_ID, EmployeeID, MachineName, BoxNumber, FileNumber, " & _
           "TrackingDate, TrackingNumberPrefix, TrackingNumberAct, " & _
           "TrackingNumberShipping , TrackingNumberParsel" & _
           "FROM tblTrackingParse"
    
'   sSQL = "SELECT BoxNumber, FileNumber, TrackingDate, TrackingNumberPrefix, " & _
'            "TrackingNumberAct, TrackingNumberShipping, TrackingNumberParsel " & _
'            "FROM dbo.tblTrackingParse " & _
'            "WHERE FileNumber <> '.box.end.' " & _
'            "AND BoxNumber NOT LIKE 'NBC%' " & _
'            "AND Len(BoxNumber) < 30 " & _
'            "AND TrackingNumberPrefix LIKE '1Z'"

   
   Set dbs = CurrentDb
   Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
   If Not rst.BOF Then rst.MoveFirst
   
   ' For this template, the data must be placed on the 4th row, third column.
   ' (these values are set to constants for easy future modifications)
   iCol = cStartColumn
   iRow = cStartRow

Stop
   Do Until rst.EOF
      iFld = 0
      lRecords = lRecords + 1
'      Me.lblMsg.Caption = "Exporting record #" & lRecords & " to SalesOutput.xls"
'      Me.Repaint
      
      For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
         wks.Cells(iRow, iCol) = rst.Fields(iFld)
         
         If InStr(1, rst.Fields(iFld).Name, "Date") > 0 Then
            wks.Cells(iRow, iCol).NumberFormat = "mm/dd/yyyy"
         End If
         
         wks.Cells(iRow, iCol).WrapText = False
         iFld = iFld + 1
      Next
      
      wks.Rows(iRow).EntireRow.AutoFit
      iRow = iRow + 1
      rst.MoveNext
   Loop
   
   ExportRequest = "Total of " & lRecords & " rows processed."
'   Me.lblMsg.Caption = "Total of " & lRecords & " rows processed."
   
exit_Here:
   ' Cleanup all objects  (resume next on errors)
   On Error Resume Next
   Set wks = Nothing
   Set wbk = Nothing
   Set appExcel = Nothing
   Set rst = Nothing
   Set dbs = Nothing
   DoCmd.Hourglass False
   Exit Function
   
endit:
Exit Function

err_Handler:
    Select Case Err
        Case 2501
            'Do Nothing
        Case Else
            MsgBox _
            "An unexpected error has been detected" & Chr(13) & _
            "Error Number: " & Err.Number & " , " & Err.Description & Chr(13) & _
            vbCrLf & "Please note the above details before contacting support"
    End Select
Resume endit
End Function

Thanks

John Fuhrman