Solved Export search form data to excel (1 Viewer)

oxicottin

oxicottin

Learning by pecking away....
Local time
Today, 07:03
Joined
Jun 26, 2007
Messages
856
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
 
pbaldy

pbaldy

Wino Moderator
Staff member
Local time
Today, 04:03
Joined
Aug 30, 2003
Messages
36,125
This is the usual method of debugging string variables:


If you don't spot the problem, post the finished string here.
 
oxicottin

oxicottin

Learning by pecking away....
Local time
Today, 07:03
Joined
Jun 26, 2007
Messages
856
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
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 12:03
Joined
Sep 21, 2011
Messages
14,304
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? :(
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 12:03
Joined
Sep 21, 2011
Messages
14,304
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?
 
E

ebs17

Well-known member
Local time
Today, 13:03
Joined
Feb 7, 2020
Messages
1,946
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.
 
oxicottin

oxicottin

Learning by pecking away....
Local time
Today, 07:03
Joined
Jun 26, 2007
Messages
856
@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
 
oxicottin

oxicottin

Learning by pecking away....
Local time
Today, 07:03
Joined
Jun 26, 2007
Messages
856
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
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 12:03
Joined
Sep 21, 2011
Messages
14,304
oxicottin said:
@pbaldy the debug result says true in the immediate window.
Click to expand...
Click to expand...

That will because you are comparing Me.RecordSource to your sql string, and as they are the same the result is True. :(
Code: 
strSQL = Me.RecordSource = "SELECT * FROM qry_AdvancedSearch  " & BuildFilter
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 12:03
Joined
Sep 21, 2011
Messages
14,304
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.
 
oxicottin

oxicottin

Learning by pecking away....
Local time
Today, 07:03
Joined
Jun 26, 2007
Messages
856
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
218
plog
P
C
Solved i want to change this code to merge two excel files to one sheet side by side.
Replies
2
Views
221
camiramzi
C
oxicottin
Search Form errors for date.
Replies
16
Views
1,249
Micron
M
T
Solved Append table to excel file
Replies
8
Views
817
ebs17
E
F
Add query data to existing export function
Replies
1
Views
356
MarkK
MarkK

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom