Export to Excel working, but Access query used is not working thru VBA code (1 Viewer)

Keevin77

Registered User.
Local time
Today, 01:16
Joined
May 2, 2014
Messages
13
First off, I would like to say this site has helped me out so so much. I have been coming here for almost a year now. Thanks for the great site.

My problem:
I have created an Access query, that has a where clause based on a Form fields that user can filter by. User hits run report button to export data to excel. My query works as expected if ran in Access itself. But when ran thru VBA, if i filter with the Form's dropbox's, it returns empty. But if i get rid of the where clause, it returns all the tables data.

I need to export this data to a template file, that i have setup to create pivot tables based on the data. Everything will be working one I can get the vba code to return the query data. Below is my code

Access Query:
SELECT ITEM_FE.WM_YR_WK, ITEM_FE.Saved_Date, ITEM_FE.JDA_VNDR_STAT_CD, ITEM_FE.Cat, ITEM_FE.SubCat, ITEM_FE.Vendor_NBR, ITEM_FE.Vendor_Name, ITEM_FE.REPL_GROUP_NBR, ITEM_FE.ITEM1_DESC, ITEM_FE.ITEM2_DESC, ITEM_FE.Item, ITEM_FE.LocCnt, ITEM_FE.FCST, ITEM_FE.Sales, ITEM_FE.FCST_Accuracy, ITEM_FE.Sum_FE
FROM ITEM_FE
WHERE ((ITEM_FE.WM_YR_WK between Forms!GRS_FE![wmyrwkbox1] and Forms!GRS_FE![wmyrwkbox2]) Or Forms!GRS_FE![wmyrwkbox1] Is Null) And (ITEM_FE.JDA_VNDR_STAT_CD in (Forms!GRS_FE![JDABox1], Forms!GRS_FE![JDABox2],Forms!GRS_FE![JDABox3]) Or Forms!GRS_FE![JDABox1] Is Null) AND (ITEM_FE.Item in (Forms!GRS_FE![ItemBox1], Forms!GRS_FE![ItemBox2], Forms!GRS_FE![ItemBox3], Forms!GRS_FE![ItemBox4], Forms!GRS_FE![ItemBox5], Forms!GRS_FE![ItemBox6]) Or Forms!GRS_FE![ItemBox1] Is Null) AND (ITEM_FE.Cat in (Forms!GRS_FE![CatBox1], Forms!GRS_FE![CatBox2], Forms!GRS_FE![CatBox3], Forms!GRS_FE![CatBox4], Forms!GRS_FE![CatBox5]) Or Forms!GRS_FE![CatBox1] Is Null) And (ITEM_FE.SubCat in (Forms!GRS_FE![SubCatBox1], Forms!GRS_FE![SubCatBox2], Forms!GRS_FE![SubCatBox3], Forms!GRS_FE![SubCatBox4], Forms!GRS_FE![SubCatBox5]) Or Forms!GRS_FE![SubCatBox1] Is Null) And (ITEM_FE.Vendor_NBR in (Forms!GRS_FE![VendorNbrBox1], Forms!GRS_FE![VendorNbrBox2], Forms!GRS_FE![VendorNbrBox3], Forms!GRS_FE![VendorNbrBox4], Forms!GRS_FE![VendorNbrBox5]) Or Forms!GRS_FE![VendorNbrBox1] Is Null) And (ITEM_FE.Vendor_Name in (Forms!GRS_FE![VendorNameBox1], Forms!GRS_FE![VendorNameBox2], Forms!GRS_FE![VendorNameBox3], Forms!GRS_FE![VendorNameBox4], Forms!GRS_FE![VendorNameBox5]) Or Forms!GRS_FE![VendorNameBox1] Is Null)
ORDER BY 1, 3, 4, 5, 11;
VBA Code:
Code:
Option Compare Database
Public Saveitas As String
Public M As String
Public Y As String
Dim objExcel As Object
Dim xlApp As Object
Public x As Integer
Public xx As Integer
Public xxx As Integer
Public xxxx As Integer
Const strHmtTemplateFile As String = "L:\SVP_Replen_Plan\Space Planning\Systems\Systems Team\Keevin Claypool\GRS Reporting\Item FE Template.xlsx"
'------------------------------------------------------------
' GRSExport
'------------------------------------------------------------
Public Sub GRSExport1()
On Error Resume Next
 
    ' Test to see if the file currently exist, if so, delete file, so new file can be written.
    Kill ("C:\Documents and Settings\" & VBA.Environ("username") & "\Desktop\Item FE.xls")
    If Dir("C:\Documents and Settings\" & VBA.Environ("username") & "\Desktop\Item FE.xls") <> "" Then
        MsgBox "Item FE.xls File already in use!" & vbNewLine & "Please Close File, then rerun Report."
    Else
        x = 0
        'Dim strOutputFile As String
        Dim strTemplateFile As String
        Dim intCells As Long
        Dim xlApp As Excel.Application
        Dim xlWorkbook As Workbook
 
        M = Month(Date)
        Y = Year(Date)
        D = Day(Date)
        strTemplateFile = strHmtTemplateFile
        'strOutputFile = "C:\Documents and Settings\" & VBA.Environ("username") & "\Desktop\Item FE"
        Saveitas = "C:\Documents and Settings\" & VBA.Environ("username") & "\Desktop\Item FE.xls"
        DoEvents
 
        Set xlApp = CreateObject("Excel.Application")
        xlApp.Workbooks.Open strTemplateFile
        xlApp.Visible = False
 
        DoEvents
        'Export routines
        'Store Data
 
        Export_Data_To_Excel xlApp, "DataQuery", 16, 256, "DataQuery"
 
        If Len(Dir$(Saveitas)) > 0 Then
            SetAttr Saveitas, vbNormal
            VBA.Kill Saveitas
        End If
 
        xlApp.Sheets("DataQuery").Activate
        Debug.Print
        xlApp.ActiveWorkbook.SaveAs Saveitas
        xlApp.Visible = True
        Debug.Print
 
        Set xlApp = Nothing
        DoCmd.SetWarnings False
    End If
GRSExport1_Exit:
    Exit Sub
End Sub
Public Function Export_Data_To_Excel(xlApp As Excel.Application, Source_Table As String, Field_Count As Long, Initial_Cell As Long, Workbook_tab As String)
    Dim DB1 As Database
    Dim rst1 As Recordset
    Dim fld1 As Field
    Dim intRow As Long
    Dim intColumn As Long
 
    intCells = Initial_Cell
    Set DB1 = CurrentDb()
    Set rst1 = DB1.OpenRecordset("DataQuery")
 
    xlApp.Sheets(Workbook_tab).Activate
    If x = 0 Then
    intRow = 2
    intColumn = 1
    End If
 
    Do Until rst1.EOF
        With xlApp.Sheets(Workbook_tab)
            For intFields = 0 To Field_Count - 1
                .cells(intRow, intColumn) = rst1.Fields(intFields)
                intColumn = intColumn + 1
            Next intFields
        End With
        intRow = intRow + 1
        intCells = intCells + 1
        intColumn = 1
        rst1.MoveNext
    Loop
 
    Set rst1 = Nothing
    Set DB1 = Nothing
    x = x + 1
End Function
 
Last edited:

Keevin77

Registered User.
Local time
Today, 01:16
Joined
May 2, 2014
Messages
13
I have also slimmed down the data query listed below. and still no data returned. but if hard code an item number, it returns data as expected. So my syntax in the Where clause for the form fields has to be throwing the query. Thanks all for your help.

SELECT ITEM_FE.WM_YR_WK, ITEM_FE.Saved_Date, ITEM_FE.JDA_VNDR_STAT_CD, ITEM_FE.Cat, ITEM_FE.SubCat, ITEM_FE.Vendor_NBR, ITEM_FE.Vendor_Name, ITEM_FE.REPL_GROUP_NBR, ITEM_FE.ITEM1_DESC, ITEM_FE.ITEM2_DESC, ITEM_FE.Item, ITEM_FE.LocCnt, ITEM_FE.FCST, ITEM_FE.Sales, ITEM_FE.FCST_Accuracy, ITEM_FE.Sum_FE
FROM ITEM_FE
WHERE ITEM_FE.Item = Forms!GRS_FE![ItemBox1].value
ORDER BY 1, 3, 4, 5, 11;
 

spikepl

Eledittingent Beliped
Local time
Today, 07:16
Joined
Nov 3, 2010
Messages
6,144
Debugging while flying blind ("thanks" to "On Error Resume Next") makes little sense :D
 

JHB

Have been here a while
Local time
Today, 07:16
Joined
Jun 17, 2012
Messages
7,732
Comment out the "On Error Resume Next" line as spikepl mention.
Then run the code, do you get any error now?
Else post you database with some sample data (zip it) + name of the form in which you have the problem.
 

Keevin77

Registered User.
Local time
Today, 01:16
Joined
May 2, 2014
Messages
13
commented out, i get error message

Too few parameters. Expected 1.


Ill work on getting copy zipped and attached. thx
 

Rx_

Nothing In Moderation
Local time
Today, 00:16
Joined
Oct 22, 2009
Messages
2,803
Code:
 strSQLBattery = "SELECT Wells_TankBattery.ID_TankBattery AS Battery_ID, Wells_TankBattery_1.Wells_ID, Wells_Areas.Area, Wells.Well_Name AS [Well Name], Wells_Status1.Status1 AS [Well Status], [02_PadSHLRpt].QQ, [02_PadSHLRpt].Section AS Sec, [02_PadSHLRpt].Township AS Twp, [02_PadSHLRpt].Range AS Rng, [02_PadSHLRpt].[Final Footage] AS FT1, [02_PadSHLRpt].[FNL-FSL] AS [FNL-FSL], [02_PadSHLRpt].[Final Footage 2] AS FT2, [02_PadSHLRpt].[FEL-FWL] AS [FEL-FWL], [Request Move Final] AS Status, Wells_Prodg_Fmn.Prodg_Fmn AS Formation"
strSQLBattery = strSQLBattery & " FROM Wells_TankBattery AS Wells_TankBattery_1 RIGHT JOIN (Wells_TankBattery INNER JOIN (Wells_Prodg_Fmn RIGHT JOIN (Wells_Areas INNER JOIN (WellType INNER JOIN ((Wells_Status1 INNER JOIN ((Wells INNER JOIN tblWells_County ON Wells.ID_County = tblWells_County.ID_County) INNER JOIN States ON Wells.ID_State = States.ID_State) ON Wells_Status1.ID_WellStatus1 = Wells.ID_WellsStatus1) LEFT JOIN 02_PadSHLRpt ON Wells.ID_Wells = [02_PadSHLRpt].ID_Wells) ON WellType.WellTypeID = Wells.WellTypeID) ON Wells_Areas.ID_Area = Wells.ID_Area) ON Wells_Prodg_Fmn.ID_Prodg_Fmn = Wells.ID_Prodg_Fmn) ON Wells_TankBattery.ID_TankBattery = Wells.ID_Battery) ON Wells_TankBattery_1.Wells_ID = Wells.ID_Wells"
strSQLBattery = strSQLBattery & " WHERE (((Wells.Activity)='A') AND ((Wells_Areas.ID_Area) Not In (1000))) OR (((Wells.Activity)='A') AND ((Wells_Areas.ID_Area) Not In (1000)))"
strSQLBattery = strSQLBattery & " ORDER BY Wells_TankBattery.ID_TankBattery, Wells_TankBattery_1.Wells_ID DESC , Wells.Well_Name, Wells_Areas.Area, Well_Name_Sorted([Well_Name]);"
 
550 Debug.Print " sql string = " & strSQLBattery ' for test purposes
560 Set rsDataSundries = CurrentDb.OpenRecordset(strSQLBattery, dbOpenSnapshot, dbReadOnly)
Maybe for a newbie, sugget the debug.print statement. Then they can copy it back into a new query window (SQL view). Actually, it is something I use myself just to keep track of any variable added to a SQL statement later. Or... to see what the heck I did somewhere a couple of months ago.
As a newbe, break the SQL statement into the Select, From, Where and OrderBy to make it a little more readable.
Eventually, some queries can fill up an entire page.
 

Keevin77

Registered User.
Local time
Today, 01:16
Joined
May 2, 2014
Messages
13
thanks for taking a look. the problem has to lie in the dataquery3, where i have a where clause pointing to a drop box on the form. if you manually run the query, it works fine, but thru the vba code, it does not.

I tried attaching the database, but i am blocked from doing so with my work firewall.

what can i do to get further help from you guys?
 

Rx_

Nothing In Moderation
Local time
Today, 00:16
Joined
Oct 22, 2009
Messages
2,803
Create a variable
MyVariable as string
before running the SQL statement
MyVariable = Forms!(your list box code here)
debug.print "MyVariable is: " & MyVariable
In your code window menu - View Immediate Window
This will expose the value of your listbox value and its data type

Create a string argument MySQL as String
Use the format I posted above to put it into the query.
The debug. print statement will expose what you are trying to do at run time.
It is your Where statement that has the problem
It might be a data type conversion for example.
 

Keevin77

Registered User.
Local time
Today, 01:16
Joined
May 2, 2014
Messages
13
Thx RX, will try your suggestion here shortly.
 

Keevin77

Registered User.
Local time
Today, 01:16
Joined
May 2, 2014
Messages
13
I got my data type mismatch error cleared up. I still have one problem tho I hope I can get some help with.

I had previously built a access query, that a user can select data criteria from dropdown boxes, and leave any of them empty if they did not want to filter by the box. Here is the query. I have more fields that are in dropboxes, but made it shorter for ease of understanding.

SELECT ITEM_FE.WM_YR_WK, ITEM_FE.Saved_Date, ITEM_FE.JDA_VNDR_STAT_CD, ITEM_FE.Cat, ITEM_FE.SubCat, ITEM_FE.Vendor_NBR, ITEM_FE.Vendor_Name, ITEM_FE.REPL_GROUP_NBR, ITEM_FE.ITEM1_DESC, ITEM_FE.ITEM2_DESC, ITEM_FE.Item, ITEM_FE.LocCnt, ITEM_FE.FCST, ITEM_FE.Sales, ITEM_FE.FCST_Accuracy, ITEM_FE.Sum_FE
FROM ITEM_FE
WHERE
((ITEM_FE.WM_YR_WK between Forms!GRS_FE![wmyrwkbox1] and Forms!GRS_FE![wmyrwkbox2]) Or Forms!GRS_FE![wmyrwkbox1] Is Null)

AND (ITEM_FE.Item in (Forms!GRS_FE![ItemBox1], Forms!GRS_FE![ItemBox2], Forms!GRS_FE![ItemBox3], Forms!GRS_FE![ItemBox4], Forms!GRS_FE![ItemBox5], Forms!GRS_FE![ItemBox6])
Or Forms!GRS_FE![ItemBox1] Is Null) ORDER BY 1, 3, 4, 5, 11;


That query above works great. But my export function when calling that query, just would not work. So I re-created the query in VBA editor, and I have the query working somewhat, with the exception of the user being able to leave any of the boxes empty. How would I write the vba sql to be able to allow for an empty box. Basically, the user should be able to select a WeekYear range, and if they want to filter on item as well, key in the item in up to 6 boxes. Currently you have to key all 6 boxes to return data, you can key say just 3. And if the user leaves the first Item box empty, I want to pull all items. Once I get this working, I will be able to replicate for the other drop boxes I have. Here is my current VBA SQL Code.

Code:
    Dim rst1SQL As String
    rst1SQL = "SELECT ITEM_FE.WM_YR_WK, ITEM_FE.Saved_Date, ITEM_FE.JDA_VNDR_STAT_CD, ITEM_FE.Cat, ITEM_FE.SubCat, ITEM_FE.Vendor_NBR, ITEM_FE.Vendor_Name, ITEM_FE.REPL_GROUP_NBR, ITEM_FE.ITEM1_DESC, ITEM_FE.ITEM2_DESC, ITEM_FE.Item, ITEM_FE.LocCnt, ITEM_FE.FCST, ITEM_FE.Sales, ITEM_FE.FCST_Accuracy, ITEM_FE.Sum_FE " & _
    "FROM ITEM_FE " & _
    "WHERE (ITEM_FE.WM_YR_WK between " & Forms!GRS_FE!wmyrwkbox1.Value & " and " & Forms!GRS_FE!wmyrwkbox2 & ") " & _
    "And (ITEM_FE.Item in (" & Forms!GRS_FE!ItemBox1 & ", " & Forms!GRS_FE!ItemBox2 & ", " & Forms!GRS_FE!ItemBox3 & ", " & Forms!GRS_FE!ItemBox4 & ", " & Forms!GRS_FE!ItemBox5 & ", " & Forms!GRS_FE!ItemBox6 & ") Or " & Forms!GRS_FE!ItemBox1 & " Is Null) " & _
    "ORDER BY 1,3,4,5,11;"
    MsgBox rst1SQL
    Set rst1 = CurrentDb.OpenRecordset(rst1SQL)

I've attached the msgbox of the translated SQL, and the error msg. Thx again.
 
Last edited:

Keevin77

Registered User.
Local time
Today, 01:16
Joined
May 2, 2014
Messages
13
Got my query working and filtering correctly on whatever the user wants to filter by
 

Users who are viewing this thread

Top Bottom