I've been all over this site, as well as others, just trying to find a solution that works for my code, but have had no luck. The last attempt, I used the Total Access Analyzer source code. It worked fine...until I inserted my code in between the start and close of Excel. My code is shown, below:
Private Sub cmdManipulateXLFile_Click()
On Error GoTo Err_cmdManipulateXLFile_Click
DoCmd.SetWarnings False
''WILL UNCOMMENT WHEN FINISHED
'DoCmd.OpenQuery "qryQTRLYPRSNLEXP0010MaketblLastQtrPersonalExpenses", acNormal, acEdit
'DoCmd.OpenQuery "qryQTRLYPRSNLEXP0020AppendTotblLastQtrPersonalExpenses", acNormal, acEdit
'DoCmd.OpenQuery "qryQTRLYPRSNLEXP0030AppendTotblLastQtrPersonalExpenses", acNormal, acEdit
DoCmd.OutputTo acQuery, "qryQTRLYPRSNLEXP0040SortedReport", acFormatXLS, "\\Alb1pwafpr01\local\COMMON\TandE-PCard\TravelandExpense\New GELCO\Access Database for T&E\Reports\Quarterly\Personal Expenses\Files Sent\QtrlyPersExps" & Format(Date, "yyyy-mm-dd") & ".xls", False, ""
DoCmd.SetWarnings True
'Hides built-in Excel messages
Excel.Application.DisplayAlerts = False
Dim mobjExcel As CExcel2003Extended
Set mobjExcel = New CExcel2003Extended
'Start an instance of Excel
mobjExcel.StartExcel True
'**********THIS IS WHERE MY CODE STARTS**********
'Create default workbook
mobjExcel.OpenWorkbook ("\\Alb1pwafpr01\local\COMMON\TandE-PCard\TravelandExpense\New GELCO\Access Database for T&E\Reports\Quarterly\Personal Expenses\Files Sent\QtrlyPersExps" & Format(Date, "yyyy-mm-dd") & ".xls")
Sheets("qryQTRLYPRSNLEXP0040SortedRepor").Select
Sheets("qryQTRLYPRSNLEXP0040SortedRepor").Name = "Qtrly Pers Exps"
Columns("E:E").Select
Selection.NumberFormat = "mm/dd/yyyy"
Cells.Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:4").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "Personal Expenses (Due to AMEX)"
Range("A2").Select
ActiveCell.FormulaR1C1 = "Data From " & Format(Me.txtStartDt, "mm-dd-yyyy") & " Through " & Format(Me.txtEndDt, "mm-dd-yyyy")
Range("A1").Select
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Selection.Font.Bold = True
Range("A1:F1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A2").Select
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Selection.Font.Bold = True
Range("A2:F2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Columns("A:F").EntireColumn.AutoFit
Range("A1:F1").Select
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$5"
.PrintTitleColumns = ""
End With
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "&6Run Date: &D, &T"
.RightFooter = ""
.LeftMargin = Excel.Application.InchesToPoints(0.25)
.RightMargin = Excel.Application.InchesToPoints(0.25)
.TopMargin = Excel.Application.InchesToPoints(1)
.BottomMargin = Excel.Application.InchesToPoints(1)
.HeaderMargin = Excel.Application.InchesToPoints(0.5)
.FooterMargin = Excel.Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
'ActiveWorkbook.Save
Excel.ActiveWorkbook.SaveAs FileName:= _
"\\Alb1pwafpr01\local\COMMON\TandE-PCard\TravelandExpense\New GELCO\Access Database for T&E\Reports\Quarterly\Personal Expenses\Files Sent\QtrlyPersExps" & Format(Date, "yyyy-mm-dd") & ".xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'Unhides built-in Excel messages
Excel.Application.DisplayAlerts = True
'**********THIS IS WHERE MY CODE ENDS**********
''Close Workbook (leave commented out if you wish to see results above)
'mobjExcel.CloseWorkbook False
''Close Excel (leave commented out if you wish to see results above)
'mobjExcel.CloseExcel
'Set mobjExcel = Nothing
Exit_cmdManipulateXLFile_Click:
Exit Sub
Err_cmdManipulateXLFile_Click:
MsgBox Err.Description
Resume Exit_cmdManipulateXLFile_Click
End Sub
Private Sub cmdManipulateXLFile_Click()
On Error GoTo Err_cmdManipulateXLFile_Click
DoCmd.SetWarnings False
''WILL UNCOMMENT WHEN FINISHED
'DoCmd.OpenQuery "qryQTRLYPRSNLEXP0010MaketblLastQtrPersonalExpenses", acNormal, acEdit
'DoCmd.OpenQuery "qryQTRLYPRSNLEXP0020AppendTotblLastQtrPersonalExpenses", acNormal, acEdit
'DoCmd.OpenQuery "qryQTRLYPRSNLEXP0030AppendTotblLastQtrPersonalExpenses", acNormal, acEdit
DoCmd.OutputTo acQuery, "qryQTRLYPRSNLEXP0040SortedReport", acFormatXLS, "\\Alb1pwafpr01\local\COMMON\TandE-PCard\TravelandExpense\New GELCO\Access Database for T&E\Reports\Quarterly\Personal Expenses\Files Sent\QtrlyPersExps" & Format(Date, "yyyy-mm-dd") & ".xls", False, ""
DoCmd.SetWarnings True
'Hides built-in Excel messages
Excel.Application.DisplayAlerts = False
Dim mobjExcel As CExcel2003Extended
Set mobjExcel = New CExcel2003Extended
'Start an instance of Excel
mobjExcel.StartExcel True
'**********THIS IS WHERE MY CODE STARTS**********
'Create default workbook
mobjExcel.OpenWorkbook ("\\Alb1pwafpr01\local\COMMON\TandE-PCard\TravelandExpense\New GELCO\Access Database for T&E\Reports\Quarterly\Personal Expenses\Files Sent\QtrlyPersExps" & Format(Date, "yyyy-mm-dd") & ".xls")
Sheets("qryQTRLYPRSNLEXP0040SortedRepor").Select
Sheets("qryQTRLYPRSNLEXP0040SortedRepor").Name = "Qtrly Pers Exps"
Columns("E:E").Select
Selection.NumberFormat = "mm/dd/yyyy"
Cells.Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:4").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "Personal Expenses (Due to AMEX)"
Range("A2").Select
ActiveCell.FormulaR1C1 = "Data From " & Format(Me.txtStartDt, "mm-dd-yyyy") & " Through " & Format(Me.txtEndDt, "mm-dd-yyyy")
Range("A1").Select
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Selection.Font.Bold = True
Range("A1:F1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A2").Select
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Selection.Font.Bold = True
Range("A2:F2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Columns("A:F").EntireColumn.AutoFit
Range("A1:F1").Select
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$5"
.PrintTitleColumns = ""
End With
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "&6Run Date: &D, &T"
.RightFooter = ""
.LeftMargin = Excel.Application.InchesToPoints(0.25)
.RightMargin = Excel.Application.InchesToPoints(0.25)
.TopMargin = Excel.Application.InchesToPoints(1)
.BottomMargin = Excel.Application.InchesToPoints(1)
.HeaderMargin = Excel.Application.InchesToPoints(0.5)
.FooterMargin = Excel.Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
'ActiveWorkbook.Save
Excel.ActiveWorkbook.SaveAs FileName:= _
"\\Alb1pwafpr01\local\COMMON\TandE-PCard\TravelandExpense\New GELCO\Access Database for T&E\Reports\Quarterly\Personal Expenses\Files Sent\QtrlyPersExps" & Format(Date, "yyyy-mm-dd") & ".xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'Unhides built-in Excel messages
Excel.Application.DisplayAlerts = True
'**********THIS IS WHERE MY CODE ENDS**********
''Close Workbook (leave commented out if you wish to see results above)
'mobjExcel.CloseWorkbook False
''Close Excel (leave commented out if you wish to see results above)
'mobjExcel.CloseExcel
'Set mobjExcel = Nothing
Exit_cmdManipulateXLFile_Click:
Exit Sub
Err_cmdManipulateXLFile_Click:
MsgBox Err.Description
Resume Exit_cmdManipulateXLFile_Click
End Sub