Exporting Query from Access to Excel - Inconsistent Results
Hello,
The code below is meant to export a query from Access and apply all necessary formatting to the file and saves the file to my desktop.
The functionality works, but there are some rough edges that I'm trying to polish off that have been bothering me:
- Sometimes Excel will open up the file as intended, sometimes it just saves a copy to my desktop. I don't know what is causing this inconsistency.
- When opening the the file for the first time on my desktop, I always get a 'This file is already open. Reopening will cause changes to be discarded etc...' I have to click "No" for the formatting to be preserved; otherwise, it will just be the raw unformatted query. How do I fix this?
Thanks!
Code:
Private Sub Command111_Click()
Dim myQueryName As String
Dim FileName As String
Dim myExportFileName As String
Dim Xl As Excel.Application
Dim XlBook As Excel.Workbook
Dim X11 As Excel.Workbooks
Dim XlSheet As Excel.Worksheet
Dim LR As Long
Dim LRR As Long
Dim LRRR As Long
FileName = Me.Vendor_Client & " Tax Refund Request - " & Me.Vendor_Name
myQueryName = "Refund Schedule Query"
myExportFileName = Environ("UserProfile") & "\Desktop\" & FileName & " Credit Schedule.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, myQueryName, myExportFileName, True
'Excel Functions
'Open Excel and the workbook
Set Xl = CreateObject("Excel.Application")
Set XlBook = GetObject(myExportFileName)
Set XlSheet = XlBook.Worksheets(1)
Xl.Visible = True
XlBook.Windows(1).Visible = True
'Page Formatting and Footer
With XlBook.Worksheets(1).PageSetup
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.Orientation = xlLandscape
.CenterFooter = "&P of &N"
.LeftFooter = Me.Vendor_Client
.RightFooter = "&D"
End With
'Edits
XlSheet.Rows(1).EntireRow.Insert
XlSheet.Rows(1).EntireRow.Insert
XlSheet.Rows(1).EntireRow.Insert
XlSheet.Rows(1).EntireRow.Insert
With Range("A5: I5")
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeBottom).Weight = xlThin
End With
XlSheet.Range("A1") = Me.Vendor_Client
XlSheet.Range("A2") = Me.Engagement
XlSheet.Range("A3") = Me.Vendor_Name & " Tax Refund Credit Schedule"
XlSheet.Rows(1).Font.Bold = True
XlSheet.Rows(2).Font.Bold = True
XlSheet.Rows(3).Font.Bold = True
XlSheet.Rows(4).Font.Bold = True
XlSheet.Rows(5).Font.Bold = True
XlSheet.Columns(12).EntireColumn.Delete
XlSheet.Columns(11).EntireColumn.Delete
XlSheet.Columns(10).EntireColumn.Delete
'freeze pane
XlSheet.Columns("B:I").AutoFit
'Sums
LR = Range("G" & Rows.Count).End(xlUp).Row
Range("G" & LR + 1).Formula = "=SUM(G6:G" & LR & ")"
LRR = Range("H" & Rows.Count).End(xlUp).Row
Range("H" & LR + 1).Formula = "=SUM(H6:H" & LR & ")"
LRRR = Range("k" & Rows.Count).End(xlUp).Row
Range("i" & LR + 1).Formula = "=SUM(i6:k" & LR & ")"
Range("G" & LR + 1, "i" & LR + 1).Font.Bold = True
With Range("G" & LR + 1, "i" & LR + 1)
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeBottom).Weight = xlThin
End With
'Sheet name
XlSheet.Name = "Refund Schedule"
End Sub
