Solved Export search form data to excel (1 Viewer)

oxicottin

oxicottin

Learning by pecking away....
Local time
Today, 13:52
Joined
Jun 26, 2007
Messages
883
I have a continuous form that's a search form and I need to export the data/criteria it populates in the detail section. I pieced together what I thought would work but im getting an error 3075 and debug takes me to

Code: 
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qry_AdvancedSearch", outputFileName, True

Export to Excell button.....

Code: 
Private Sub cmdExportToExcel_Click()

    Dim outputFileName As String
    Dim XL As Object
    Dim strSQL As String

    outputFileName = "C:\Documents and Settings\" & Environ("username") & "\Desktop\Production_Export_" & Format(Date, "MM-dd-yyyy") & ".xls"

    If Len(Dir$(outputFileName)) > 0 Then
        Kill outputFileName
    End If
   
    strSQL = Me.RecordSource = "SELECT * FROM qry_AdvancedSearch  " & BuildFilter

    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qry_AdvancedSearch", outputFileName, True

    Set XL = CreateObject("Excel.Application")
    XL.Workbooks.Open outputFileName
    XL.Visible = False

    With XL

        .Range("E2:E1000").NumberFormat = "hh:mm"     '"h:mm AM/PM"    'specified Time format was showing 1/0/1900
        .ErrorCheckingOptions.NumberAsText = False    'Clears the green error arrows
        .Range("A1:T1").Font.Bold = True
        .Range("A1:T1").Font.Name = "Segoe UI Light"
        .Range("A1:T1").Font.Size = 12
        .Range("A1:T1").Interior.ColorIndex = 44    'http://dmcritchie.mvps.org/excel/colors.htm
        .Range("A2:T1000").Font.Name = "Segoe UI Light"
        .Range("A2:T1000").Font.Size = 10
        .Columns("A:T").EntireColumn.AutoFit    'Auto fits colums to the largest text


    End With
    XL.ActiveWorkbook.Save
    XL.Application.Quit
    Set XL = Nothing

    MsgBox "Congrats your data has been uploaded to your desktop in a .xls file", vbInformation, "Upload Complete"


End Sub

Filter function code used in my form...

Code: 
Private Function BuildFilter() As Variant
    Dim varWhere As Variant
    Dim lngLen As Long
   
    varWhere = Null  ' Main filter
   
'*************************************************************************************
'Look at each search box, and build up the criteria string from the non-blank ones.
'*************************************************************************************
'-------------------------------------------------------------------------------------------------------
' Check For Employee
    If Not IsNull(Me.cboEmployees) Then
        varWhere = varWhere & "[EmployeeID] = " & Me.cboEmployees & " AND "
    End If
'-------------------------------------------------------------------------------------------------------
' Check For Product
    If Not IsNull(Me.cboProduct) Then
        varWhere = varWhere & "[ProductID] = " & Me.cboProduct & " AND "
    End If
'-------------------------------------------------------------------------------------------------------
' Check For Length
    If Not IsNull(Me.cboLength) Then
        varWhere = varWhere & "([Length] = '" & Replace(Me.cboLength, "'", "''") & "') AND "
    End If
'-------------------------------------------------------------------------------------------------------
' Check For Machine
    If Not IsNull(Me.cboLine) Then
        varWhere = varWhere & "[MachineID] = " & Me.cboLine & " AND "
    End If
'-------------------------------------------------------------------------------------------------------
'Check for NOT LIKE in Keyword Search
    If Me.txtNotInKeyword > "" Then
        varWhere = varWhere & "[ProductionProblems] NOT LIKE ""*" & Me.txtNotInKeyword & "*"" AND "
    End If
'-------------------------------------------------------------------------------------------------------
'Check for LIKE in Keyword Search
    If Me.txtSearchKeyword > "" Then
        varWhere = varWhere & "[ProductionProblems] LIKE ""*" & Me.txtSearchKeyword & "*"" AND "
    End If
'-------------------------------------------------------------------------------------------------------
' Check For Shift
    If Not IsNull(Me.cboShift) Then
        varWhere = varWhere & "[ShiftID] = " & Me.cboShift & " AND "
    End If
'-------------------------------------------------------------------------------------------------------
' Check if there is a filter to return...
    If IsNull(varWhere) Then
        varWhere = ""
' msg if no data
'MsgBox "No criteria", vbInformation, "Nothing to do."
        Me.FilterOn = True
    Else
        varWhere = "WHERE " & varWhere
       
' strip off last "AND" in the filter
        If Right(varWhere, 5) = " AND " Then
            varWhere = Left(varWhere, Len(varWhere) - 5)
        End If
    End If
   
    BuildFilter = varWhere
   
End Function

Capture.JPG
 
This is the usual method of debugging string variables:


If you don't spot the problem, post the finished string here.
 
pbaldy said:
This is the usual method of debugging string variables:


If you don't spot the problem, post the finished string here.
Click to expand...

Sorry site is blocked by my company.... I thought it would be like:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "strSQL", outputFileName, True
 
Well for a start strSql is within quotes, so that is just a word? which is meant to be name of query/table?
I have never seen it used with a sql string.?

Do you ever lookup the syntax for commands you are using? :(
 
On my phone at the hospital, but I would expect you need to.modify a querydef with that sql (when you get it correct) and then use that query in your transferspreadsheet?
 
oxicottin said:
I have a continuous form that's a search form and I need to export the data/criteria it populates in the detail section.
Click to expand...
You can directly take the recordset from your search form and copy it into the Excel sheet. This is particularly recommended since you opened the workbook using automation anyway.

Code: 
xlWorksheet.Cells(2, 1).CopyFromRecordset Me.Recordset

A variation would be to open a new workbook and rename the worksheet as desired.
 
@pbaldy the debug result says true in the immediate window.

@Gasman I also removed the "" from.
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strSQL, outputFileName, True

Do you mean add something like.

Code: 
With CurrentDb.QueryDefs("qry_AdvancedSearch")
     .SQL = strSQL
  End With

I added the above and it gives me a error.
Capture.JPG


then debug takes me to .SQL = strSQL
 
Alright I think im getting somewhere... @pbaldy Im able to get a result from debug but I get a different error.

RESULT:
SELECT * FROM qry_AdvancedSearch WHERE [ProductID] = 36 AND [ShiftID] = 1

ERROR:
Capture.JPG


Code: 
Private Sub cmdExportToExcel_Click()

    Dim outputFileName As String
    Dim XL As Object
    Dim strSQL As String

    outputFileName = "C:\Documents and Settings\" & Environ("username") & "\Desktop\Production_Export_" & Format(Date, "MM-dd-yyyy") & ".xls"

    If Len(Dir$(outputFileName)) > 0 Then
        Kill outputFileName
    End If
   
    strSQL = Me.RecordSource
   
    Debug.Print strSQL
   
    With CurrentDb.QueryDefs("qry_AdvancedSearch")
     .SQL = strSQL
    End With
   
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qry_AdvancedSearch", outputFileName, True

    Set XL = CreateObject("Excel.Application")
    XL.Workbooks.Open outputFileName
    XL.Visible = False

    With XL

        .Range("E2:E1000").NumberFormat = "hh:mm"     '"h:mm AM/PM"    'specified Time format was showing 1/0/1900
        .ErrorCheckingOptions.NumberAsText = False    'Clears the green error arrows
        .Range("A1:T1").Font.Bold = True
        .Range("A1:T1").Font.Name = "Segoe UI Light"
        .Range("A1:T1").Font.Size = 12
        .Range("A1:T1").Interior.ColorIndex = 44    'http://dmcritchie.mvps.org/excel/colors.htm
        .Range("A2:T1000").Font.Name = "Segoe UI Light"
        .Range("A2:T1000").Font.Size = 10
        .Columns("A:T").EntireColumn.AutoFit    'Auto fits colums to the largest text


    End With
    XL.ActiveWorkbook.Save
    XL.Application.Quit
    Set XL = Nothing

    MsgBox "Congrats your data has been uploaded to your desktop in a .xls file", vbInformation, "Upload Complete"


End Sub
 
oxicottin said:
@pbaldy the debug result says true in the immediate window.

@Gasman I also removed the "" from.
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strSQL, outputFileName, True

Do you mean add something like.

Code: 
With CurrentDb.QueryDefs("qry_AdvancedSearch")
     .SQL = strSQL
  End With

I added the above and it gives me a error.
View attachment 109821

then debug takes me to .SQL = strSQL
Click to expand...
Only when you have some sort of valid sql string. :(

CopyFromRecordset might be the way to go for you?, a lot easier.
 
I got it working.... When I added the QueryDefs it was overriding my query (qry_AdvancedSearch) so I created a dummy query (qry_Dummy_AdvancedSearch) so it could build it in that instead of changing my query that the form uses to look up data. Thanks all!!!!

Code: 
Private Sub cmdExportToExcel_Click()

    Dim outputFileName As String
    Dim XL As Object
    Dim strSQL As String

    outputFileName = "C:\Documents and Settings\" & Environ("username") & "\Desktop\Production_Export_" & Format(Date, "MM-dd-yyyy") & ".xls"

    If Len(Dir$(outputFileName)) > 0 Then
        Kill outputFileName
    End If
   
    strSQL = Me.RecordSource
   
    With CurrentDb.QueryDefs("qry_Dummy_AdvancedSearch")
     .SQL = strSQL
    End With
   
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qry_Dummy_AdvancedSearch", outputFileName, True

    Set XL = CreateObject("Excel.Application")
    XL.Workbooks.Open outputFileName
    XL.Visible = False

    With XL

        .Range("E2:E1000").NumberFormat = "hh:mm"     '"h:mm AM/PM"    'specified Time format was showing 1/0/1900
        .ErrorCheckingOptions.NumberAsText = False    'Clears the green error arrows
        .Range("A1:T1").Font.Bold = True
        .Range("A1:T1").Font.Name = "Segoe UI Light"
        .Range("A1:T1").Font.Size = 12
        .Range("A1:T1").Interior.ColorIndex = 44    'http://dmcritchie.mvps.org/excel/colors.htm
        .Range("A2:T1000").Font.Name = "Segoe UI Light"
        .Range("A2:T1000").Font.Size = 10
        .Columns("A:T").EntireColumn.AutoFit    'Auto fits colums to the largest text


    End With
    XL.ActiveWorkbook.Save
    XL.Application.Quit
    Set XL = Nothing

    MsgBox "Congrats your data has been uploaded to your desktop in a .xls file", vbInformation, "Upload Complete"


End Sub
 
You must log in or register to reply here.

Similar threads

oxicottin
Cant get form filter to work correctly
Replies
8
Views
396
plog
P
R
Closing Excel from Access VBA
2 3
Replies
59
Views
1,636
ebs17
E
J
Use VBA to export form data to Excel, but keep getting "We Found a Problem..." when opening the file in Excel
Replies
5
Views
77
June7
June7
L
Consuming an API to retrieve data and store it in a Microsoft Access table.
Replies
3
Views
286
lbcurrier
L
A
Solved Referring to a control on a subform from the parent form.
Replies
3
Views
235
AlliCarr
A

Users who are viewing this thread

Total: 2 (members: 0, guests: 2)
Back
Top Bottom