Consulting

Results 1 to 2 of 2

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

  1. #1

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

    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!


    Option Compare Database
    
    
    
    
    
    
    Function ExportToExcel()
    
    
    
    
    Dim lngColumn As Long
    Dim xlx As Object, xlw As Object, xlsx As Object, xlc As Object
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim blnEXCEL As Boolean, blnHeaderRow As Boolean
    
    
    blnEXCEL = False
    
    
    ' Replace True with False if you do not want the first row of
    ' the worksheet to be a header row (the names of the fields
    ' from the recordset)
    blnHeaderRow = True
    
    
    ' Establish an EXCEL application object
    On Error Resume Next
    Set xlx = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
          Set xlx = CreateObject("Excel.Application")
          blnEXCEL = True
    End If
    Err.Clear
    On Error GoTo 0
    
    
    ' Change True to False if you do not want the workbook to be
    ' visible when the code is running
    xlx.Visible = True
    
    
    ' Replace C:\Filename.xlsx with the actual path and filename
    ' of the EXCEL file into which you will write the data
    Set xlw = xlx.Workbooks.Open("C:\UGH\Follow Up Orders mmddyyyy.xlsx")
    
    
    ' Replace WorksheetName with the actual name of the worksheet
    ' in the EXCEL file
    ' (note that the worksheet must already be in the EXCEL file)
    Set xlsx = xlw.Worksheets("Orders")
    
    
    ' Replace A1 with the cell reference into which the first data value
    ' is to be written
    Set xlc = xlsx.Range("A1") ' this is the first cell into which data go
    
    
    Set dbs = CurrentDb()
    
    
    ' Replace QueryOrTableName with the real name of the table or query
    ' whose data are to be written into the worksheet
    Set rst = dbs.OpenRecordset("FollowUpOrders", dbOpenDynaset, dbReadOnly)
    
    
    If rst.EOF = False And rst.BOF = False Then
    
    
          rst.MoveFirst
    
    
          If blnHeaderRow = True Then
                For lngColumn = 0 To rst.Fields.Count - 1
                      xlc.Offset(0, lngColumn).value = rst.Fields(lngColumn).Name
                Next lngColumn
                Set xlc = xlc.Offset(1, 0)
          End If
    
    
          ' write data to worksheet
          Do While rst.EOF = False
                For lngColumn = 0 To rst.Fields.Count - 1
                      xlc.Offset(0, lngColumn).value = rst.Fields(lngColumn).value
                Next lngColumn
                rst.MoveNext
                Set xlc = xlc.Offset(1, 0)
          Loop
    
    
    End If
    
    
    rst.Close
    Set rst = Nothing
    
    
    dbs.Close
    Set dbs = Nothing
    
    
    ' Close the EXCEL file while saving the file, and clean up the EXCEL objects
    Set xlc = Nothing
    Set xlsx = Nothing
    xlw.Close True   ' close the EXCEL file and save the new data
    Set xlw = Nothing
    If blnEXCEL = True Then xlx.Quit
    Set xlx = Nothing
    
    
    
    
    
    
    End Function

  2. #2
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    I would add the following code
    Dim dated as string
    dated = format(date, "mm") & format(date, "dd") & format(date, "yyyy")

    After the line of code
    Set dbs = Nothing
    add in
    xlw.SaveAs "C:\UGH\Follow Up Orders " & dated & ".xlsx"

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •