Solved Append table to excel file (2 Viewers)

[trax1337]

I'm trying something quite basic I assume but it's not working. I want to append the contents of an access table to an excel file or create the excel file if it does not exist. So far I either get errors or the excel file is overwritten instead of the data being appended.
This is my full code:

Sub ExportArchiveToExcel()
    Dim archiveFileName As String
    Dim archiveFilePath As String
    Dim recordCount As Long
    Dim yearPart As String
    Dim excelApp As Object
    Dim excelWorkbook As Object
    Dim excelWorksheet As Object
    
    ' ---- Export to Excel ----
    ' Create the archive file name
    yearPart = Format(Now, "yyyy")
    archiveFileName = "DayShelfAdjLog_" & yearPart & ".xlsx"
    
    ' Determine the archive file path (in the same folder as the db)
    archiveFilePath = CurrentProject.Path & "\" & archiveFileName
        
    ' Count the records in tbl_logs_archive
    recordCount = DCount("*", "tbl_logs_archive")
    
    ' Nothing to do if there no records
    If recordCount > 0 Then
        ' Check if the archive file already exists
        If Len(Dir(archiveFilePath)) = 0 Then
            Debug.Print "Archive file missing, creating a new one, condition: " & Len(Dir(archiveFilePath))
          
            ' If it doesn't exist, create a new Excel file
            DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _
                "tbl_logs_archive", archiveFilePath, True
        Else
            Debug.Print "Found an existing file"
        End If
        
        ' Open the Excel application
        Set excelApp = CreateObject("Excel.Application")
        
        ' Open the Excel workbook
        Set excelWorkbook = excelApp.Workbooks.Open(archiveFilePath)
        
        ' Set active worksheet name
        Set excelWorksheet = excelWorkbook.Sheets("tbl_logs_archive")
        
        ' Find the last row with data in the worksheet
        Dim lastRow As Long
        lastRow = excelWorksheet.Cells(excelWorksheet.Rows.Count, "A").End(-4162).Row + 1
        
        ' Export data from tbl_logs_archive starting from the next available row
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _
            "tbl_logs_archive", archiveFilePath, True, excelWorksheet.Name & "!A" & lastRow
        
        ' Save and close the Excel workbook
        excelWorkbook.Save
        excelWorkbook.Close
        excelApp.Quit
        
        ' Release Excel objects
        Set excelWorksheet = Nothing
        Set excelWorkbook = Nothing
        Set excelApp = Nothing
                
            '------------------
        Else
            ' If tbl_logs_archive has no entries, display a message
            Debug.Print "No records to export to Excel.", vbInformation
        End If

This is the part of the code where things go wrong:

  ' Export data from tbl_logs_archive starting from the next available row

        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _

            "tbl_logs_archive", archiveFilePath, True, excelWorksheet.Name & "!A" & lastRow

It tries to create a new file, so I'm either using range parameter wrong or the command is only used for creating files not appending data to files.

 

[ebs17]

A range specification in TransferSpreadsheet only works for import, not for export.

If you open the Excel workbook via automation anyway, forget TransferSpreadsheet and use CopyFromRecordset.
shortened:

' Export data from tbl_logs_archive starting from the next available row
Set rs = CurrentDb.Openrecordset("tbl_logs_archive")
excelWorksheet.Cells(1, lastRow).CopyFromRecordset rs
rs.Close

With the CopyFromRecordset method you could also directly copy a form recordset that has just been additionally filtered.

 

[trax1337]

Thanks, small typo there I think, but made it work with:

excelWorksheet.Cells(lastRow, "A").CopyFromRecordset rs

Out of curiosity is there a way I can do it without opening the excel sheet? Or are there other methods, just trying to wrap my head around access and vba.



Also previous to the code above I query a table and I insert the result in the table from the code above, tbl_logs_archive, can the step be skipped and just query a table and then insert the result straight into excel?

Sub ArchiveDeletedLogs()
    Dim dbC As DAO.Database
    Set dbC = CurrentDb
    Dim deleteYears As Integer
    Dim deleteDate As Date
    Dim logCount As Long
    
    ' ---- Archive Deleted Logs ----
    ' Retrieve the "DeleteLogsAfterYears" value from the "settings" table, record ID 1
    deleteYears = DLookup("DeleteLogsAfterYears", "tbl_settings", "ID = 1")
    
    ' Calculate the date to delete records before
    deleteDate = DateAdd("yyyy", -deleteYears, Date)
    
    ' Check if there are logs to be deleted
    logCount = DCount("*", "tbl_adj_logs", "AdjDate < #" & Format(deleteDate, "yyyy/mm/dd") & "#")
    
    ' If there are logs to be deleted, proceed with archiving
    If logCount > 0 Then
        ' Delete all existing entries in tbl_logs_archive
        strSQL = "DELETE * FROM tbl_logs_archive;"
        dbC.Execute strSQL
        
        ' Insert deleted log entries into tbl_logs_archive
        strSQL = "INSERT INTO tbl_logs_archive (EAN, CrtStock, Adjustment, AdjDate) " & _
                 "SELECT EAN, CrtStock, Adjustment, AdjDate " & _
                 "FROM tbl_adj_logs " & _
                 "WHERE AdjDate < #" & Format(deleteDate, "yyyy/mm/dd") & "#;"
        
        ' Execute the INSERT statement to archive deleted logs
        dbC.Execute strSQL, dbFailOnError
        
                      
        ' Clean up
        Set dbC = Nothing
      
    End If


End Sub

Thanks for the help.

 

[ebs17]

excelWorksheet.Cells(lastRow, 1).CopyFromRecordset rs

Of course, first the row, then the column. My mistake.

Actually, it should also work if you link the Excel table to your frontend and then directly apply a query to it. Appending and updating should work, deleting doesn't.
But the Excel table has to exist.

About your code: The detour via tbl_logs_archive seems unnecessary to me. If I trust my code, I add immediately to the Excel table by timestamp and then delete in the original log table. In order for the process to run completely, it should be encapsulated in a transaction.

 

[trax1337]

excelWorksheet.Cells(lastRow, 1).CopyFromRecordset rs

Of course, first the row, then the column. My mistake.

Actually, it should also work if you link the Excel table to your frontend and then directly apply a query to it. Appending and updating should work, deleting doesn't.
But the Excel table has to exist.

About your code: The detour via tbl_logs_archive seems unnecessary to me. If I trust my code, I add immediately to the Excel table by timestamp and then delete in the original log table. In order for the process to run completely, it should be encapsulated in a transaction.

Could you provide a snippet on how I would avoid this `detour`?

Assuming my query would be:

strSQL = "SELECT EAN, CrtStock, Adjustment, AdjDate " & _
      "FROM tbl_adj_logs " & _
      "WHERE AdjDate < #" & Format(deleteDate, "yyyy/mm/dd") & "#;"

How would I send it to excel file? preparing for both cases where the excel file would not exist or when it does and the table should just be appended?

 

[June7]

Suggest you review this site http://accessmvp.com/KDSnell/EXCEL_MainPage.htm

Could use CopyFromRecordset whether creating new or appending worksheet.

Can export query object but if need dynamic parameters, code must modify query object.

Linking to Excel with External Data wizard will not allow Excel linked data to be editable. However, a link can be established via a query object to allow some data editing. Since you can't be certain that Excel file exists, link approach is not practical.

 

[ebs17]

Linking to Excel with the External Data wizard will not allow the Excel linked data to be editable.

SELECT T.* FROM [excel 12.0 xml;hdr=yes;imex=1;DATABASE=D:\Anywhere\MyFile.xlsx].[Table1$] AS T

You would use something like this for table access within the other query.

 

[ebs17]

Sub Untested()
    Dim db As DAO.Database
    Dim qd As DAO.QueryDef
    Dim sSQL As String
    Dim sFile As String
    Dim lFlag As Long

    On Error GoTo Exit_Err
    Set db = CurrentDb
    sFile = CurrentProject.Path & "\MyLog.xlsx"
    If Dir(sFile) > vbNullString Then
    Else
        sSQL = "SELECT EAN, CrtStock, Adjustment, AdjDate FROM tbl_adj_logs WHERE False"
        Set qd = db.CreateQueryDef(sSQL, "MyLogTable")
        qd.Close
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "MyLogTable", sFile
        db.QueryDefs("MyLogTable").Delete
    End If

    lFlag = 1   
    DAO.DBEngine.BeginTrans

    sSQL = "INSERT INTO [excel 12.0 xml;hdr=yes;imex=1;DATABASE=" & sFile & "].[MyLogTable$]" & _
           " (EAN, CrtStock, Adjustment, AdjDate)" & _
           " SELECT EAN, CrtStock, Adjustment, AdjDate FROM tbl_adj_logs" & _
           " WHERE AdjDate < DateAdd('yyyy', -3, Date())"
    db.Execute sSQL, dbFailOnError
    sSQL = "DELETE tbl_adj_logs  WHERE AdjDate < DateAdd('yyyy', -3, Date())"
    db.Execute sSQL, dbFailOnError

    DAO.DBEngine.CommitTrans
    Exit Sub

Exit_Err:
    If lFlag = 1 Then DAO.DBEngine.Rollback
    MsgBox "Transaction failed. Error: " & Err.Description
End Sub

 

[ebs17]

By the way, I would ask why you archive in Excel. A text file (=> CSV) only contains plain text, can hold up to around 2 GB and would be able to hold a lot of records, so that the division into many individual files could be saved or at least significantly reduced.