Code to export files from query with filename based upon field contents

[Mattbro]

Hi


I use an acOutputquery command to export a file to a specific path. I am trying to see if I can export multiple files with filenames based upon a field in the query. I appreciate that this approach may not work, but....

If I have a Table, say ‘TbKingdoms’ with a Field- “OwnerName”, with some rows where the OwnerName is “Tom”, some rows where the OwnerName is “Fred” and some rows where the OwnerName is empty.
I write a query to TbKingdoms; QryOwners –Select all where OwnerName is not null. Currently, that will give me a single file containing all data for Tom and Fred.
I want to use acOutputQuery to generate two files-“Fred.XLS” containing data where OwnerName is Fred, and “Tom.XLS” where ownername is Tom.
Thus far, I have:
SQL for QryOwners:

SELECT TbKingdom.Kingdom, TbKingdom.OwnerName
FROM TbKingdom INNER JOIN TbOwnerName ON TbKingdom.OwnerName = TbOwnerName.OwnerName
WHERE (((TbKingdom.OwnerName Is Not Null));

And code for the output

 
Private Sub BtnGenerate_Click()
Dim db As Database
Dim rs1 As Recordset
Dim strRunFor As String
Dim strPath As String
Dim networkPath As String
networkPath = "C:\My Kingdoms\"
Set db = CurrentDb
Set rs1 = db.OpenRecordset("TbKingdoms", dbOpenSnapshot)
Do Until rs1.EOF
strPath = OwnerName & ".xls"
exportPath = networkPath & strPath
DoCmd.OutputTo acOutputQuery, "QryOwners", acFormatXLS, exportPath, False
rs1.MoveNext
Loop
Set rs1 = Nothing
Set db = Nothing
End Sub

This is generating a single excel file in the correct location, with no filename that cannot be opened. Any input very much appreciated.
Thanks,
Mattbro451

[Gicu]

Your approach is slightly wrong as you don't want to loop through the entire table, you only want to do it twice and each time you need to modify the SQL statement of the query to only include the selected OwnerName:

Private Sub BtnGenerate_Click()
Dim db As Database
Dim rs1 As Recordset
Dim strRunFor As String
Dim strPath As String
Dim networkPath As String

Dim sOwnername as string
Dim qdf as DAO.QueryDef


networkPath = "C:\My Kingdoms\"
Set db = CurrentDb
'Set rs1 = db.OpenRecordset("TbKingdoms", dbOpenSnapshot)
Set rs1 = db.OpenRecordset("SELECT OwnerName FROM TbKingdoms GROUP BY OwnerName HAVING (OwnerName IS Not Null);", dbOpenSnapshot)
Set qdf=CurrentDb.QueryDefs("QryOwners")
qdf.SQL="SELECT Kingdom, OwnerName FROM TbKingdom  WHERE OwnerName ='" & sOwnerName & "';"

Do Until rs1.EOF
sOwnername =rs1("OwnerName")
'strPath = OwnerName & ".xls"
strPath = sOwnername & ".xls"
exportPath = networkPath & strPath
DoCmd.OutputTo acOutputQuery, "QryOwners", acFormatXLS, exportPath, False
rs1.MoveNext
Loop

Set qdf=Nothing
Set rs1 = Nothing
Set db = Nothing
End Sub

Cheers,
Vlad

[Mattbro]

Vlad, this is terrific but its giving me two interesting issues. The first is that the files generated do have the filename exactly as requested, however they are empty-they should contain the Ownername and relevant kingdoms.
The second is that running this changes the SQL on QryOwners from;

SELECT TbKingdom.Kingdom, TbKingdom.OwnerName
FROM TbKingdom INNER JOIN TbOwner ON TbKingdom.OwnerName = TbOwner.Owner
WHERE (((TbKingdom.OwnerName) Is Not Null));

...to

SELECT TbKingdom.Kingdom, TbKingdom.OwnerName
FROM TbKingdom
WHERE (((TbKingdom.[OwnerName])=''));

Any ideas?
Many thanks,
Mattbro451

[Gicu]

Sorry Matt,
I misplaced the line that sets the querydef.sql property, try this one:

Private Sub BtnGenerate_Click()
Dim db As Database
Dim rs1 As Recordset
Dim strRunFor As String
Dim strPath As String
Dim networkPath As String


Dim sOwnername as string
Dim qdf as DAO.QueryDef




networkPath = "C:\My Kingdoms\"
Set db = CurrentDb
'Set rs1 = db.OpenRecordset("TbKingdoms", dbOpenSnapshot)
Set rs1 = db.OpenRecordset("SELECT OwnerName FROM TbKingdoms GROUP BY OwnerName HAVING ([OwnerName] Is Not Null);", dbOpenSnapshot)
Set qdf=CurrentDb.QueryDefs("QryOwners")


Do Until rs1.EOF
sOwnername =rs1("OwnerName")
if len(sOwnerName)=0 then Goto Next_Record
'strPath = OwnerName & ".xls"
strPath = sOwnername & ".xls"
exportPath = networkPath & strPath

qdf.SQL="SELECT Kingdom, OwnerName FROM TbKingdom  WHERE OwnerName ='" & sOwnerName & "';"



DoCmd.OutputTo acOutputQuery, "QryOwners", acFormatXLS, exportPath, False

Next_Record:
rs1.MoveNext
Loop


Set qdf=Nothing
Set rs1 = Nothing
Set db = Nothing
End Sub

Cheers,
Vlad

[Mattbro]

Thanks Vlad-this is great as is, but when I adapt it, though it is doing exactly what it is supposed to, it is corrupting the SQL for what was QryOwners.
In the adaption,

TbKingdom is TbG2ASSP where Kingdom=PartNo and ownername=ReportingObserver. There is a "DateObserved" filed too.

TbOwnername is TbObserver where Ownername=Observer
QryOwners is QryPartOutput with the following SQL

SELECT TbG2ASSP.PartNo, TbG2ASSP.ReportingObserver. TbG2ASSP.DateObserved
FROM TbG2ASSP INNER JOIN TbObserver ON TbG2ASSP.ReportingObserver = TbObserver.Observer WHERE (((TbG2ASSP. ReportingObserver Is Not Null));

And the revised VB is;

Private Sub BtnGenerate_Click()
Dim db As Database
Dim rs1 As Recordset
Dim strRunFor As String
Dim strPath As String
Dim networkPath As String
Dim sReportingObserver As String
Dim qdf As DAO.QueryDef
networkPath = "C:\My Documents\Test\"
Set db = CurrentDb
'Set rs1 = db.OpenRecordset("TbG2ASSP", dbOpenSnapshot)
Set rs1 = db.OpenRecordset("SELECT ReportingObserver FROM TbG2ASSP GROUP BY ReportingObserver HAVING (ReportingObserver Is Not Null);", dbOpenSnapshot)
Set qdf = CurrentDb.QueryDefs("QryPartOutput")
Do Until rs1.EOF
sReportingObserver = rs1("ReportingObserver")
If Len(sReportingObserver) = 0 Then GoTo Next_Record
'strPath = ReportingObserver & ".xls"
strPath = sReportingObserver & ".xls"
exportPath = networkPath & strPath
qdf.SQL = "SELECT [Part Number], [DateObserved],[ReportingObserver] FROM TbG2ASSP WHERE ReportingObserver ='" & sReportingObserver & "';"
DoCmd.OutputTo acOutputQuery, "QryPartOutput ", acFormatXLS, exportPath, False
Next_Record:
rs1.MoveNext
Loop
Set qdf = Nothing
Set rs1 = Nothing
Set db = Nothing
DoCmd.Quit
End Sub

I suspect I have an error in the ambiguous use of "Reporting Observer" in the VB. Can you tell me which line would be changing the SQL?
Really appreciate the input.
THanks,
Mattbro451

[Gicu]

Why include tblObserver in qryPartOutput if you don't use it?

SELECT TbG2ASSP.PartNo, TbG2ASSP.ReportingObserver. TbG2ASSP.DateObserved
FROM TbG2ASSP INNER JOIN TbObserver ON TbG2ASSP.ReportingObserver = TbObserver.Observer WHERE (((TbG2ASSP. ReportingObserver Is Not Null));

should be:

SELECT PartNo, ReportingObserver. DateObserved
FROM TbG2ASSP WHERE ReportingObserver Is Not Null;

qdf.SQL = "SELECT [Part Number], [DateObserved],[ReportingObserver] FROM TbG2ASSP WHERE ReportingObserver ='" & sReportingObserver & "';"

notice you have [Part Number] on this line but the actual name of the field is PartNo. To include the date this line of code should be:

qdf.SQL = "SELECT [PartNo], [DateObserved],[ReportingObserver] FROM TbG2ASSP WHERE ReportingObserver ='" & sReportingObserver & "';"

And maybe at the end of the sub before setting qdf=Nothing reset its SQL to the initial one:

qdf.SQL="SELECT PartNo, ReportingObserver. DateObserved FROM TbG2ASSP WHERE ReportingObserver Is Not Null;"
Set qdf= Nothing

Cheers,
Vlad

[accesstos]

Hi guys!

In this case, there is no need to use an existing and useful QueryDef.
We can create a new "temporary" QueryDef at run-time and delete it at the end.

Give a try to this version:

Sub BtnGenerate_Click()
    Dim db As Database
    Dim rs As Recordset
    Dim qd As QueryDef

    Set db = CurrentDb
    'Create the "temporary" QueryDef.
    On Error Resume Next
    Set qd = db.CreateQueryDef("qd")
    'Open a recordset with the unique values of 'ReportingObserver' plus a field with the output file name.
    On Error GoTo ErrH
    Set rs = db.OpenRecordset("SELECT DISTINCT ReportingObserver, " _
                              & "'C:\My Documents\Test\' & [ReportingObserver] & '.xls' AS OutputFile " _
                              & "FROM TbG2ASSP " _
                              & "WHERE ((Not (ReportingObserver) Is Null) " _
                              & "AND ((Len([ReportingObserver]))>0));", dbOpenForwardOnly)
    'Export to Excel
    While Not rs.EOF
        qd.SQL = "SELECT [PartNo], [DateObserved], [ReportingObserver] " _
                 & "FROM  TbG2ASSP WHERE ReportingObserver ='" & rs!ReportingObserver & "';"
        DoCmd.OutputTo acOutputQuery, qd.Name, acFormatXLS, rs!OutPutFile, False
        rs.MoveNext
    Wend
ExitHere:
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    'Delete the "temporary" QueryDef
    db.QueryDefs.Delete qd.Name
    Set qd = Nothing
    Set db = Nothing
    Exit Sub
ErrH:
    MsgBox "Unexpected error #" & Err & vbCrLf & Err.Description, vbExclamation
    Resume ExitHere
End Sub

Have a nice weekend!
John

[Mattbro]

Perfect. Many thanks Vlad!
Mattbro451

[Mattbro]

Thanks John. Vlads solution has worked, but I'll give your response a try too-interested in the concept of temporary Query Defs.
Many thanks,
Mattbro451

[Gicu]

Glad to hear! I think John's solution will work too, many ways to skin a cat....

Cheers,

[accesstos]

Thanks John. Vlads solution has worked, but I'll give your response a try too-interested in the concept of temporary Query Defs.
Many thanks,
Mattbro451

You are welcome!

It was obvious from the start that Slav's code works well, furthermore, it is too hard to find a blemish in his solutions, generally.
My intent was just to show a way that doesn't use any object except the basic table to export.
Happy to see happy people with solved issues.

By the way, the recordset (rs) with the unique names and file paths could be a stored query to make the code more robust and flexible.

Good luck with your project!
John