Export data from Access to multiple Excel files using a filtered string from a drop down list on a form

try

Set xlObj = CreateObject("Excel.Application")
    xlObj.workbooks.Add
Set Sheet = xlObj.activeworkbook.workSheets(1)

If Not IsNull(Me.Director) Then Sheet.Name = Me.Director   '<< add this line

Sorry, I put Advanced when I was filling out the new question submission format, as I thought it meant I was asking for advanced help, not that I was advanced; I'm definitely not advanced with VB ;)

     Ok, I just tried your suggestion, and if I filter by a Director's name it names the tab after the string selected in the filter; however, if I leave the filter blank it just returns one file with all of the information in it.
                                     Here is the main thing I want to accomplish here:
*****  If the filter is left blank I want it to run I want it to run the module named "mod_WSAManagementVerified_ExportToMultipleExcelFiles"

                                     Here are a couple of minor thing I would like the code to do:
*** Just as you did with the last question, I would like the file and sheet name to be named after the concatenated field in the query the data is being pulled from [FullName].[qry_WSAManagementVerified_Export]
***  Also like the last question, I do not want it to return the concatenated field, as it is only there for file naming purposes.

     Thanks in advance, Jon  I mistakenly had the wrong query listed in my initial question for where the data is pulled; here is the correct code that works as described above:

Option Compare Database
Option Explicit
Dim strFilter As String

Private Sub cmdExport_click()
Dim rs As DAO.Recordset, sql1, ssql, db As DAO.Database, qd As DAO.QueryDef
Dim sWhere As String
sWhere = ""
Set db = DBEngine.Workspaces(0).Databases(0)
Set qd = db.QueryDefs("qry_WSAManagementVerified_Export")
If InStr(qd.sql, "Where") > 0 Then
    sql1 = Left(qd.sql, InStr(qd.sql, "Where") - 1)
    sWhere = Mid(qd.sql, InStr(qd.sql, "Where"))
    sWhere = Left(sWhere, InStr(sWhere, ";") - 1)
    Else
    sql1 = Replace(qd.sql, ";", "")
 
End If

' Accounts for Null values returned by strFilter
If Len(strFilter) > 0 Then
    If Len(sWhere) > 0 Then
        sWhere = sWhere & " And " & strFilter
        ssql = sql1 & " " & sWhere
        Else
        ssql = sql1 & " Where " & strFilter
    End If
    Else
    ssql = Replace(qd.sql, ";", "")
End If


Set rs = CurrentDb.OpenRecordset(ssql)


Dim xlObj As Object, xlFile As String
Dim Sheet As Object
xlFile = "C:\MyExcelFile.xls"

Set xlObj = CreateObject("Excel.Application")
    xlObj.Workbooks.Add
Set Sheet = xlObj.activeworkbook.Sheets(1)
   
If Not IsNull(Me.Director) Then Sheet.Name = Me.Director   '<< add this line
   
'This copies the headers
Dim iRow, iCol
iRow = 1
    For iCol = 0 To rs.Fields.Count - 1
        Sheet.cells(iRow, iCol + 1).Value = rs.Fields(iCol).Name
    Next

'This copies just the data
Sheet.Range("A2").CopyFromRecordset rs
xlObj.Visible = True

'xlObj.activeworkbook.SaveAs xlFile - Un-comment if you want to automatically save the file
Set Sheet = Nothing
xlObj.Quit
Set xlObj = Nothing
rs.Close
Set rs = Nothing

End Sub

    Great, it worked nicely when I ran it without selecting a Director's name; however, I get the following error:
Run-time error 3075 *** Syntax error (missing operator) in query expression '(((tbl_WSAManagementVerified.WSAFunctionRequired)="Yes")) where [Director]= "Akers, Brien T" ***

and then the dubugger highlightes:

*** Set rs = CurrentDb.OpenRecordset(ssql) ***

Below is the modified code I used; note the name of the query has changed.  Thanks again for all your help, Jon

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit
Dim strFilter As String

Private Sub Director_AfterUpdate()
strFilter = ""

    If Me.Director <> "" And Not IsNull(Me.Director) Then
        If strFilter = "" Then
            strFilter = "[Director]= " & Chr(34) & Me.Director & Chr(34) & ""
        Else
            strFilter = strFilter & " and [Director]= " & Chr(34) & Me.Director & Chr(34) & ""
        End If
    End If
End Sub
Private Sub cmdExport_click()
If IsNull(Me.Director) Then
    exp2XL2
    Else
    exp2XL
End If
End Sub


Sub exp2XL()
Dim rs As DAO.Recordset, sql1, ssql, db As DAO.Database, qd As DAO.QueryDef

Set db = DBEngine.Workspaces(0).Databases(0)
Set qd = db.QueryDefs("export_WSAManagementVerified")
sql1 = Replace(qd.SQL, ";", "")

' Accounts for Null values returned by strFilter
If Len(strFilter) > 0 Then
ssql = sql1 & " where " & strFilter
Else
ssql = sql1
End If

Set rs = CurrentDb.OpenRecordset(ssql)

Dim xlObj As Object, xlFile As String
Dim Sheet As Object
xlFile = "C:\Users\Jon\Work\WSA\Monthly Verification Excel Files\Test\MyExcelFile.xls"

Set xlObj = CreateObject("Excel.Application")
    xlObj.Workbooks.Add
Set Sheet = xlObj.activeworkbook.workSheets(1)
    Sheet.Name = Me.Director
   
'This copies the headers
Dim iRow, iCol
iRow = 1
    For iCol = 0 To rs.Fields.Count - 1
        Sheet.cells(iRow, iCol + 1).Value = rs.Fields(iCol).Name
    Next

'This copies just the data
Sheet.Range("A2").CopyFromRecordset rs
xlObj.Visible = True


'xlObj.activeworkbook.SaveAs xlFile - Un-comment if you want to automatically save the file
Set Sheet = Nothing
xlObj.Quit
Set xlObj = Nothing


End Sub

Sub exp2XL2()
Dim rs As DAO.Recordset, rsDir As DAO.Recordset
Dim ssql As String, iCol
Dim xlObj As Object
Dim Sheet As Object

Set rsDir = CurrentDb.OpenRecordset("select distinct LastName from export_WSAManagementVerified")

If rsDir.EOF Then Exit Sub
rsDir.MoveFirst


Do Until rsDir.EOF
    Set xlObj = CreateObject("Excel.Application")
    xlObj.Workbooks.Add

    ssql = "SELECT export_WSAManagementVerified.EPCFunctionID, export_WSAManagementVerified.EPCFunction,"
    ssql = ssql & " export_WSAManagementVerified.DirectorBems, export_WSAManagementVerified.Director,"
    ssql = ssql & " export_WSAManagementVerified.WGManagerBems, export_WSAManagementVerified.WGManager,"
    ssql = ssql & " export_WSAManagementVerified.WGBudgetNum, export_WSAManagementVerified.NumberOfDirectReports,"
    ssql = ssql & " export_WSAManagementVerified.NumberOfWorkgroups, export_WSAManagementVerified.WGVerified,"
    ssql = ssql & " export_WSAManagementVerified.WGWSARequired, export_WSAManagementVerified.WSAFunctionRequired,"
    ssql = ssql & " export_WSAManagementVerified.WGWSACompletions, export_WSAManagementVerified.WSACompletions_Data,"
    ssql = ssql & " export_WSAManagementVerified.WGWSARequirement, export_WSAManagementVerified.WSACompletions_Override,"
    ssql = ssql & " export_WSAManagementVerified.WGNotes"
    ssql = ssql & " FROM export_WSAManagementVerified"
    ssql = ssql & " Where export_WSAManagementVerified.LastName='" & rsDir("LastName") & "'"


    Set rs = CurrentDb.OpenRecordset(ssql, dbOpenDynaset)
   
    Set Sheet = xlObj.activeworkbook.Sheets("sheet1")
    'rename the sheet, you can use any of the recordset field
    Sheet.Name = rsDir("LastName")
    'copy the headers
        For iCol = 0 To rs.Fields.Count - 1
            Sheet.cells(1, iCol + 1).Value = rs.Fields(iCol).Name
        Next
   
   
    Sheet.Range("A2").CopyFromRecordset rs  'copy the data
   
    xlObj.activeworkbook.SaveAs "C:\Users\Jon\Work\WSA\Monthly Verification Excel Files\Test\" & rsDir("lastName") & "_" & "WSAVerification.xls", FileFormat:=-4143
 
   
    Set Sheet = Nothing
    xlObj.Quit
    Set xlObj = Nothing
rsDir.MoveNext
Loop
rsDir.Close
rs.Close
Set rsDir = Nothing
Set rs = Nothing
End Sub

I'm guessing that you will want the SQl from the query too, so here it is:

Query Name: export_WSAManagementVerified
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SELECT IIf(IsNull([Director]),"Unknown",Left([Director],InStr([Director],",")-1)) AS LastName, tbl_WSAManagementVerified.WGManagerBems, tbl_WSAManagementVerified.WGManager, tbl_WSAManagementVerified.WGBudgetNum, tbl_WSAManagementVerified.WGVerified, tbl_WSAManagementVerified.WGWSARequired, tbl_WSAManagementVerified.WGWSACompletions, tbl_WSAManagementVerified.WSACompletions_Override, tbl_WSAManagementVerified.WSACompletions_Data, tbl_WSAManagementVerified.WGWSARequirement, tbl_WSAManagementVerified.WGNotes, tbl_WSAManagementVerified.NumberOfDirectReports, tbl_WSAManagementVerified.NumberOfWorkgroups, tbl_WSAManagementVerified.EPCFunctionID, tbl_WSAManagementVerified.EPCFunction, tbl_WSAManagementVerified.WSAFunctionRequired, tbl_WSAManagementVerified.DirectorBems, tbl_WSAManagementVerified.Director
FROM tbl_WSAManagementVerified
WHERE (((tbl_WSAManagementVerified.WSAFunctionRequired)="Yes"));

I would also like to note that I still get the same error above even if I remove [WSAFunctionRequired] field from both the [export_WSAManagementVerified] query and from the VB code.  So I have no idea of what it is.  Thanks again, Jon

Jon,

first, i don't know where you got this line

(((tbl_WSAManagementVerified.WSAFunctionRequired)="Yes")) where [Director]= "Akers, Brien T" ***


post the codes *you are using*  

I don't know what the problem was, but I made a couple little adjustments today, and everything works nicely :)

Thanks again for your help, Jon