471,088 Members | 1,350 Online
Bytes | Software Development & Data Engineering Community
Post +

Home Posts Topics Members FAQ

Join Bytes and contribute your articles to a community of 471,088 developers and data experts.

How to Export a Linked Table to Excel

anoble1
239 128KB
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.

Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2.  
  3. Public Function exportToXl()
  4. Dim sFolderName As String, sFolder As String
  5. Dim sFolderPath As String
  6. Dim dbTable As String
  7. Dim xlWorksheetPath As String
  8.  
  9. 'Main Folder
  10. sFolder = "C:\Users\asdf\Documents\Backups\"
  11.  
  12. 'Folder Name
  13. sFolderName = Format(Now, "mm-dd-yyyy")
  14.  
  15. 'Folder Path
  16. sFolderPath = "C:\Users\asdf\Documents\Backups\" & sFolderName
  17.  
  18. 'Create FSO Object
  19. Set oFSO = CreateObject("Scripting.FileSystemObject")
  20.  
  21. 'Check Specified Folder exists or not
  22.     If oFSO.FolderExists(sFolderPath) Then
  23.         'If folder is available with today's date
  24.         MsgBox "Folder already exists  with today's date.", vbInformation, "VBAF1"
  25.         Exit Function
  26.     Else
  27.         'Create Folder
  28.         MkDir sFolderPath
  29.     End If
  30.  
  31.  
  32. xlWorksheetPath = sFolderPath & "\" & "Backup.xlsx"
  33.  
  34. dbTable = "tblRecords"
  35. DoCmd.TransferSpreadsheet transfertype:=acExport, spreadsheettype:=acSpreadsheetTypeExcel12Xml, tablename:=dbTable, FileName:=xlWorksheetPath, hasfieldnames:=True
  36.  
  37. ErrorHandlerExit:
  38.  
  39. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  40.  
  41. Dim xl As Excel.Application
  42. Dim wb As Excel.Workbook
  43. Dim ws As Excel.Worksheet
  44. Set xl = CreateObject("Excel.Application")
  45. Set wb = xl.Workbooks.Open(xlWorksheetPath)
  46. Set ws = wb.Sheets("Data")
  47.  
  48. wb.Application.ActiveWindow.FreezePanes = False
  49. ws.Range("a2").Select
  50.  
  51. wb.Application.ActiveWindow.FreezePanes = True
  52.  
  53. AutofitAllUsed
  54.  
  55. wb.Save
  56. wb.Close
  57.  
  58. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  59. Exit Function
  60. End Function
  61.  
  62. Sub AutofitAllUsed()
  63.  
  64. Dim x As Integer
  65.  
  66. For x = 1 To ActiveSheet.UsedRange.Columns.Count
  67.  
  68.      Columns(x).EntireColumn.AutoFit
  69.  
  70. Next x
  71.  
  72. End Sub
  73.  
4 Weeks Ago #1
0 5917

Post your reply

Sign in to post your reply or Sign up for a free account.

Similar topics

4 posts views Thread by Hans [DiaGraphIT] | last post: by
1 post views Thread by Ed Chiu | last post: by
4 posts views Thread by christianlott1 | last post: by

By using Bytes.com and it's services, you agree to our Privacy Policy and Terms of Use.

To disable or enable advertisements and analytics tracking please visit the manage ads & tracking page.