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!


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