Export to Excel and overwrite existing data

[paulcraigdainty]

I have the following statement which exports data based on a query to a .xls:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qryreportsbydate", "C:\Documents and Settings\pdainty\Desktop\RawQualityData_Weekly.xls"


This works fine it exports the data and names the sheet rawqualitydata.

The problem i'm having is when i come to run the export again Excel tells me the file already exists. What I want it to do is overwrite the data in the rawqualitydata sheet in the same file.

Is this possible?

 

[Guus2005]

What you can do is open an application based on the Excel.Application object and open the workbook/spreadsheet you mention. Using the following function you can write a recordset to a spreadsheet.

Public Sub CreateSpreadsheetFromRS(wsExcel As Worksheet, _
                                       rst As DAO.Recordset, _
                       Optional blnVisible As Boolean = True, _
                        Optional blnHeader As Boolean = True)
'Export Recordset to excel.

    Dim qdf       As QueryDef
    Dim intRij    As Integer
    Dim intVelden As Integer
    Dim intTeller As Integer

    If rst.EOF Then
        MsgBox "No records found for " & rst.Name, vbExclamation, GetAppTitle()
        Exit Sub
    End If

    intVelden = rst.Fields.Count - 1

    intRij = 0

    If blnHeader Then 'Default fieldnames are printed
        'Fieldnames first
        intRij = intRij + 1
        For intTeller = 0 To intVelden
            wsExcel.Cells(intRij, intTeller + 1) = rst.Fields(intTeller).Name
        Next intTeller
    End If

    Do While Not rst.EOF
        intRij = intRij + 1
        For intTeller = 0 To intVelden
            wsExcel.Cells(intRij, intTeller + 1) = rst.Fields(intTeller)
        Next intTeller
        rst.MoveNext
    Loop

    wsExcel.Columns.AutoFit
    wsExcel.Rows.AutoFit

    Set rst = Nothing
    Set qdf = Nothing

End Sub

Data will be overwritten.

HTH

 

[DCrake]

Simple Software Solutions

Guss

Your reply no doublt will be appreciated, however, an English version would be more understandable

CodeMaster

 

[Guus2005]

Guss

Your reply no doublt will be appreciated, however, an English version would be more understandable

CodeMaster

Oops.

Remarks in code translated.

 

[Guus2005]

Missing two functions:

Public Function CurrentMDB() As String
'Return database name
   Dim i As Integer, FullPath As String
   FullPath = CurrentDb.Name
   ' Search backward in string for back slash character.
   For i = Len(FullPath) To 1 Step -1
      ' Return all characters to the right of the back slash.
      If Mid(FullPath, i, 1) = "\" Then
         CurrentMDB = Mid(FullPath, i + 1)
         Exit Function
      End If
   Next i
End Function

Public Function GetAppTitle() As String
'Get application title or database name
    Dim strAppTitle As String
    
    On Error GoTo Err_GetAppTitle
    
    strAppTitle = CurrentDb.Properties("AppTitle")

    GetAppTitle = strAppTitle

Exit_GetappTitle:
    Exit Function
Err_GetAppTitle:
    ErrorProc Err, Err.Description, "GetappTitle", "basUtil"
    GetAppTitle = CurrentMDB()
    Resume Exit_GetappTitle
End Function