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.
Expand|Select|Wrap|Line Numbers
- 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