• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 102
  • Last Modified:

VBA Access 2010 work Access 2016 parameter fail

Former Access 2010 code worked for years
Build table and export separate spreadsheets
stepping through debug

fieldvalue = Cstr(rs("Full Facility Name"))         works
strexportquery = "Select * from MRA_52_LOCAL_Master where (((MRA_52_Local_Master.[Full Facility Name])=""" & fieldvalue & """))" works
set qdfnew = currentdb.createquerydef("myexportquerydef",strexportquery)   ......  ["created table"] works
dodmd.trasferspreadsheet acexport fails

popup window is looking for the parameter  [Full Facility Name]


FULL CODE
Function List_Entries2()

Dim fieldValue As String
    fieldValue = ""
Dim strExportQuery As String
    strExportQuery = ""
Dim curDirectory As String
    curDirectory = CurrentProject.Path
       
On Error GoTo Create_Error

    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("SELECT MRA_52_LOCAL_MASTER_2.[Full Facility Name]FROM MRA_52_LOCAL_MASTER_2 GROUP BY MRA_52_LOCAL_MASTER_2.[Full Facility Name]")
   
    If Not (rs.EOF And rs.BOF) Then
       
        rs.MoveFirst
       
        Do Until rs.EOF = True
            fieldValue = CStr(rs("Full Facility Name"))
           
            'USE QUERY RESULTS IN SECOND QUERY AND EXPORT
   strExportQuery = "Select * FROM MRA_52_LOCAL_MASTER_2 WHERE (((MRA_52_LOCAL_MASTER.[Full Facility Name])=""" & fieldValue & """))"
           
            Set qdfNew = CurrentDb.CreateQueryDef("myExportQueryDef", strExportQuery)
           
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "myExportQueryDef", curDirectory & "\LBG - " & CStr(fieldValue) & ".xls", True
           
            CurrentDb.QueryDefs.Delete qdfNew.Name
                       
            rs.MoveNext
        Loop
       
    Else
        MsgBox ("There are no records")
    End If

List_Entries_Exit:
    Exit Function

Create_Error:
        MsgBox Error$
    Resume List_Entries_Exit
   
End Function
0
avgplusguy
Asked:
avgplusguy
  • 8
  • 5
1 Solution
 
Rey Obrero (Capricorn1)Commented:
try first deleting the excel file if exists before the export

If dir(curDirectory & "\LBG - " & CStr(fieldValue) & ".xls") <> "" then
   kill curDirectory & "\LBG - " & CStr(fieldValue) & ".xls"
end if
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "myExportQueryDef", curDirectory & "\LBG - " & CStr(fieldValue) & ".xls", True
0
 
avgplusguyAuthor Commented:
Rey,
Excellent suggestion.
Once the created myexportquerydef table was a problem and had to be deleted before re-running the code. The excel files are not there and are not a problem.

Before the query exported 12 facility spreadsheets without a problem.
Now it does not recognize the first supplied "Full Facility Name" in the table
and shows a popup error

Enter Parameter Value
MRA_52_Local_Master.Full Facility Name
0
 
avgplusguyAuthor Commented:
When you cancel out of it , it says reserved error
0
Easily Design & Build Your Next Website

Squarespace’s all-in-one platform gives you everything you need to express yourself creatively online, whether it is with a domain, website, or online store. Get started with your free trial today, and when ready, take 10% off your first purchase with offer code 'EXPERTS'.

 
avgplusguyAuthor Commented:
I manually supplied the 12 facilities and it output the 12 files.
However, Each file has all 12 facilities instead of only the named facility
0
 
Rey Obrero (Capricorn1)Commented:
<However, Each file has all 12 facilities instead of only the named facility>

check your query criteria.

btw, you don't need to delete the query everytime you run the export.
you can just replace the SQL  statement of the query using the querydef

dim qd as dao.querydef
set qd=curentdb.querydefs("myExportQueryDef")

Dim rs As DAO.Recordset
     Set rs = CurrentDb.OpenRecordset("SELECT MRA_52_LOCAL_MASTER_2.[Full Facility Name]FROM MRA_52_LOCAL_MASTER_2 GROUP BY MRA_52_LOCAL_MASTER_2.[Full Facility Name]")
     
     If Not (rs.EOF And rs.BOF) Then
         
         rs.MoveFirst
         
         Do Until rs.EOF = True
             fieldValue = CStr(rs("Full Facility Name"))
             
             'USE QUERY RESULTS IN SECOND QUERY AND EXPORT
    strExportQuery = "Select * FROM MRA_52_LOCAL_MASTER_2 WHERE (((MRA_52_LOCAL_MASTER.[Full Facility Name])=""" & fieldValue & """))"

         'change the sql statement of the query
 
      qd.sql=strExportQuery

    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "myExportQueryDef", curDirectory & "\LBG - " & CStr(fieldValue) & ".xls", True
             
                       
             rs.MoveNext
         Loop
       
     Else
         MsgBox ("There are no records")
     End If
0
 
hnasrCommented:
If you can, upload a sample database, and point where to look for the problem.
0
 
avgplusguyAuthor Commented:
thank you unfortunately meetings most of the day so cant get to this now
0
 
avgplusguyAuthor Commented:
Brief Break
I like the logic of the simplification but that is producing errors of its own.
I think my main error is in the query criteria.
I want to group by the field "full facility name" and write out 12 separate spreadsheets with each spreadsheet containing just its customers.
It appears to me that the fieldvalue is not passing the values to the [full facility name] parameter
in 2016 the way it did in 2010


Function List_Entries2()

Dim fieldValue As String
    fieldValue = ""
Dim strExportQuery As String
    strExportQuery = ""
Dim curDirectory As String
    curDirectory = CurrentProject.Path
       
On Error GoTo Create_Error
   
    Dim qd As DAO.QueryDef
    Set qd = curentdb.QueryDefs("myExportQueryDef")

Error message Object Required.
0
 
Rey Obrero (Capricorn1)Commented:
change this
  Set qd = curentdb.QueryDefs("myExportQueryDef")

    curentdb should be currentdb  (double r)
with

  Set qd = currentdb.QueryDefs("myExportQueryDef")

----

also, use this
    strExportQuery = "Select * FROM MRA_52_LOCAL_MASTER_2 WHERE MRA_52_LOCAL_MASTER.[Full Facility Name]='" & fieldValue & "'"
0
 
avgplusguyAuthor Commented:
getting closer
Item not found in this collection at same place now.,,,

I changed the field name from .[Full Facility Name] to .Full_Facility_Name to see if this would help prevent the message from popping up and asking for a specific facility, but it still pops up
0
 
Rey Obrero (Capricorn1)Commented:
upload  a copy of the db.
0
 
avgplusguyAuthor Commented:
I had to get rid of identifying data, change values, dates, etc
Sample.accdb
0
 
Rey Obrero (Capricorn1)Commented:
here is the revised db, you can use both function
Sample_revised.accdb
0
 
avgplusguyAuthor Commented:
This was great. I knew I would need a little more help because my challenges are usually more that fix this line....
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Get 10% Off Your First Squarespace Website

Ready to showcase your work, publish content or promote your business online? With Squarespace’s award-winning templates and 24/7 customer service, getting started is simple. Head to Squarespace.com and use offer code ‘EXPERTS’ to get 10% off your first purchase.

  • 8
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now