422,363 Members | 2,260 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 422,363 IT Pros & Developers. It's quick & easy.

Export to/Save As a copy of template and add date to file name

P: 1
I have essentially no experience with VBA whatsoever so I'm struggling to piece this together and need help! I got the code below from Kens Access Tips website and it works perfectly, but I need it updated so it saves the worksheet as a copy of the template instead of overwriting the template. I'd also like to add the current date (date the file runs) to the workbook name.

The template is located in a folder titled "C:\UGH\"
The template name is "Follow Up Orders mmddyyyy.xlsx"
The template sheet name is "Orders"
The MS Access table is named "FollowUpOrders"

I want the code to open the template, drop the contents of "FollowUpOrders" into the "Orders" tab, then save the file as "Follow Up Orders 04122018", changing the date to be the current date of whenever it runs, leaving the original template intact.

I sincerely appreciate any and all help you can toss my way!

Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2.  
  3.  
  4.  
  5. Function ExportToExcel()
  6.  
  7.  
  8. Dim lngColumn As Long
  9. Dim xlx As Object, xlw As Object, xlsx As Object, xlc As Object
  10. Dim dbs As DAO.Database
  11. Dim rst As DAO.Recordset
  12. Dim blnEXCEL As Boolean, blnHeaderRow As Boolean
  13.  
  14. blnEXCEL = False
  15.  
  16. ' Replace True with False if you do not want the first row of
  17. ' the worksheet to be a header row (the names of the fields
  18. ' from the recordset)
  19. blnHeaderRow = True
  20.  
  21. ' Establish an EXCEL application object
  22. On Error Resume Next
  23. Set xlx = GetObject(, "Excel.Application")
  24. If Err.Number <> 0 Then
  25.       Set xlx = CreateObject("Excel.Application")
  26.       blnEXCEL = True
  27. End If
  28. Err.Clear
  29. On Error GoTo 0
  30.  
  31. ' Change True to False if you do not want the workbook to be
  32. ' visible when the code is running
  33. xlx.Visible = True
  34.  
  35. ' Replace C:\Filename.xlsx with the actual path and filename
  36. ' of the EXCEL file into which you will write the data
  37. Set xlw = xlx.Workbooks.Open("C:\UGH\Follow Up Orders mmddyyyy.xlsx")
  38.  
  39. ' Replace WorksheetName with the actual name of the worksheet
  40. ' in the EXCEL file
  41. ' (note that the worksheet must already be in the EXCEL file)
  42. Set xlsx = xlw.Worksheets("Orders")
  43.  
  44. ' Replace A1 with the cell reference into which the first data value
  45. ' is to be written
  46. Set xlc = xlsx.Range("A1") ' this is the first cell into which data go
  47.  
  48. Set dbs = CurrentDb()
  49.  
  50. ' Replace QueryOrTableName with the real name of the table or query
  51. ' whose data are to be written into the worksheet
  52. Set rst = dbs.OpenRecordset("FollowUpOrders", dbOpenDynaset, dbReadOnly)
  53.  
  54. If rst.EOF = False And rst.BOF = False Then
  55.  
  56.       rst.MoveFirst
  57.  
  58.       If blnHeaderRow = True Then
  59.             For lngColumn = 0 To rst.Fields.Count - 1
  60.                   xlc.Offset(0, lngColumn).value = rst.Fields(lngColumn).Name
  61.             Next lngColumn
  62.             Set xlc = xlc.Offset(1, 0)
  63.       End If
  64.  
  65.       ' write data to worksheet
  66.       Do While rst.EOF = False
  67.             For lngColumn = 0 To rst.Fields.Count - 1
  68.                   xlc.Offset(0, lngColumn).value = rst.Fields(lngColumn).value
  69.             Next lngColumn
  70.             rst.MoveNext
  71.             Set xlc = xlc.Offset(1, 0)
  72.       Loop
  73.  
  74. End If
  75.  
  76. rst.Close
  77. Set rst = Nothing
  78.  
  79. dbs.Close
  80. Set dbs = Nothing
  81.  
  82. ' Close the EXCEL file while saving the file, and clean up the EXCEL objects
  83. Set xlc = Nothing
  84. Set xlsx = Nothing
  85. xlw.Close True   ' close the EXCEL file and save the new data
  86. Set xlw = Nothing
  87. If blnEXCEL = True Then xlx.Quit
  88. Set xlx = Nothing
  89.  
  90.  
  91.  
  92. End Function
1 Week Ago #1
Share this Question
Share on Google+
1 Reply


NeoPa
Expert Mod 15k+
P: 30,631
Let's start with Require Variable Declaration as a freebie ;-)

Now look at line #85. What you're doing there is closing the Workbook, but nowhere do you set a name or do an explicit SaveAs. Workbooks have a .SaveAs method. It's too involved to go into detail here for now but look it up. It isn't hard to find. For the Filename parameter use a string variable that you've previously set using something like :
Expand|Select|Wrap|Line Numbers
  1. strFN = Replace("C:\UGH\FollowUpOrders%D", "%D", Format(Date(), "ddmmyyyy")
After that the xlw.Close should work without any possibility of a prompt so you should be good to go.
1 Week Ago #2

Post your reply

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