Its been a while since I tried to use automation to control Excel.
Maybe this will work:
Code:
Option Compare Database '<< should be at the top of EVERY code module
Option Explicit '<< should be at the top of EVERY code module
Function testExcel() 'my made up name, since you did not provide one :eek:
Const cstrQueryName = "CV_Roster_Summary_Query"
Const cstrSummaryQueryName = "CV_Roster_Query_Parameter_By_Subgroup"
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
' Dim srst As DAO.Recordset2 'not used
' Dim qdf As QueryDef 'not used
' Dim strSQL As String 'not used
Dim Group As String
Dim subgroup As String
Dim CurTableName As String
Dim NewTableName As String
Dim outputFileName As String
Dim xlApp As Object
Dim xlWorkbook As Object
Dim xlSheet As Object
Dim ename As String
' these were not delcared. I guessed at the types
Dim TablesLoaded As Integer
Dim TabName As String
Dim ExportFileName As String
' Open pointer to current database
Set dbs = CurrentDb()
' Open recordset on saved queries
Set rst = dbs.OpenRecordset(cstrQueryName)
rst.MoveFirst
' Deletes and prior files created that are in the Exported folder
Call Delete_External_Files
' Display data from one record and move to the next record until finished
Do While Not rst.EOF
' MsgBox "Record #: " & rst![Subgroup_Count] & " Subgroup: " & rst![subgroup] & " Member Count: " & rst![Members]
' Now query initial table for each subgroup from main loaded table
' strSQL = ""
Group = ""
subgroup = ""
CurTableName = ""
NewTableName = ""
TablesLoaded = ""
TabName = ""
ExportFileName = ""
outputFileName = ""
ename = ""
Group = rst![Group]
subgroup = rst![subgroup]
dbs.Execute "Insert Into [CV_Roster_Subgroup_" & rst![Subgroup_Count] & "] Select * from [CV_Roster_Minus_Fields] where [SubGroup] = '" & subgroup & "'"
CurTableName = "CV_Roster_subgroup_" & rst![Subgroup_Count]
' MsgBox CurTableName
' NewTableName = "CV_Roster_" & Group & "_" & subgroup
' MsgBox NewTableName
TablesLoaded = rst![Subgroup_Count]
TabName = Group & " " & subgroup
' Export table that was created to an Exce file
ExportFileName = "" & Group & "-" & subgroup & "-Enrollment File"
' MsgBox "Export File Name: " & ExportFileName
' MsgBox "TabName: " & TabName
' outputFileName = CurrentProject.Path & ExportFileName & ".xls"
outputFileName = "N:\Data Management\REPORTS - Scheduled\Jay\Enrollment By Subgroups\Exported Files" & ExportFileName & ".xlsx"
'**********************************
' You cannot use the RANGE argument when exporting.
'from Help: A string expression that's a valid range of cells or the name of a range in the spreadsheet.
' This argument applies only to importing. Leave this argument blank to import the entire spreadsheet.
'When you export to a spreadsheet, you must leave this argument blank.
'If you enter a range, the export will fail.
' DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, CurTableName, outputFileName, True, TabName
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, CurTableName, outputFileName, True
'**********************************
DoEvents
' Format output file for better readability ---- NEW Code for formatting ---------------
' *** could have used "outputFileName" instead of creating "ename" variable
ename = "N:\Data Management\REPORTS - Scheduled\Jay\Enrollment By Subgroups\Exported Files" & ExportFileName & ".xlsx"
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False 'changed position in code
Set xlWorkbook = xlApp.Workbooks.Open(ename)
' Debug.Print xlApp.ActiveWindow.ActiveSheet.Name
' Set xlSheet = xlWorkbook.Sheets(TabName)
Set xlSheet = xlWorkbook.Worksheets("Sheet1")
xlSheet.Activate
' Debug.Print xlApp.ActiveWindow.ActiveSheet.Name
With xlSheet
.Cells.Select
.Cells.EntireColumn.AutoFit
.Rows("1:1").Font.Bold = True
.Range("A1").Select
End With
With xlApp
.ActiveWindow.SplitColumn = 0
.ActiveWindow.SplitRow = 1
.ActiveWindow.FreezePanes = True
End With
xlWorkbook.Save
DoEvents
xlApp.Quit
DoEvents
'Turn on warnings
DoCmd.SetWarnings True 'not sure why this line is here. Did not see where SetWarnings was turned off???
' Get next record and re-loop
rst.MoveNext
Loop
Set xlApp = Nothing
Set xlWorkbook = Nothing ' I moved these out of the loop
Set xlSheet = Nothing
MsgBox TablesLoaded & " - Tables have been loaded with subgroup information !"
rst.Close
dbs.Close
End Function