How to Export a Linked Table to Excel

[anoble1]

This is something that was needed that I will post on here in case others have use for it.
Code will create a new folder with Today's date and file name, then export the table to excel. Then it will open and format the excel file after it is exported by freezing the top row, and will autofit the column width.
Probably not the best written but works for me.

Option Compare Database
 
Public Function exportToXl()
Dim sFolderName As String, sFolder As String
Dim sFolderPath As String
Dim dbTable As String
Dim xlWorksheetPath As String
 
'Main Folder
sFolder = "C:\Users\asdf\Documents\Backups\"
 
'Folder Name
sFolderName = Format(Now, "mm-dd-yyyy")
 
'Folder Path
sFolderPath = "C:\Users\asdf\Documents\Backups\" & sFolderName
 
'Create FSO Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
 
'Check Specified Folder exists or not
    If oFSO.FolderExists(sFolderPath) Then
        'If folder is available with today's date
        MsgBox "Folder already exists  with today's date.", vbInformation, "VBAF1"
        Exit Function
    Else
        'Create Folder
        MkDir sFolderPath
    End If
 
 
xlWorksheetPath = sFolderPath & "\" & "Backup.xlsx"
 
dbTable = "tblRecords"
DoCmd.TransferSpreadsheet transfertype:=acExport, spreadsheettype:=acSpreadsheetTypeExcel12Xml, tablename:=dbTable, FileName:=xlWorksheetPath, hasfieldnames:=True
 
ErrorHandlerExit:
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
Dim xl As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Set xl = CreateObject("Excel.Application")
Set wb = xl.Workbooks.Open(xlWorksheetPath)
Set ws = wb.Sheets("Data")
 
wb.Application.ActiveWindow.FreezePanes = False
ws.Range("a2").Select
 
wb.Application.ActiveWindow.FreezePanes = True
 
AutofitAllUsed
 
wb.Save
wb.Close
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Exit Function
End Function
 
Sub AutofitAllUsed()
 
Dim x As Integer
 
For x = 1 To ActiveSheet.UsedRange.Columns.Count
 
     Columns(x).EntireColumn.AutoFit
 
Next x
 
End Sub