resume.xlw

[scubadiver007]

I am exporting two sets of data to a v.2007 macro enabled (".xlsm") workbook so I use a function to export one set of data, close the spreadsheet and then use the second function to export the second set.

Both datasets are exported ok but I get the following error message which I haven't seen before.

A filename named "RESUME.XLW" already exists in this location. Do you want to replace it?

I think the first instance of Excel is still open as a process so the error occurs when it is opened for a second time. I think it might be because the code in the function isn't quite correct but not sure how to correct it.

Apart from the function name and the Excel reference, the two functions are the same.

Public Function SendToactivity(strTQName As String, strSheetName As String, strFilePath As String)
' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
 
' strFilePath is the name and path of the file you want to send this data into.
 
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As DAO.Field
    Dim strPath As String
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    On Error GoTo err_handler
 
 
    strPath = strFilePath
 
 
    Set rst = CurrentDb.OpenRecordset(strTQName)
 
    Set ApXL = CreateObject("Excel.Application")
 
 
    Set xlWBk = ApXL.Workbooks.Open(strPath)
 
    ApXL.Visible = True
 
   Set xlWSh = xlWBk.Worksheets(strSheetName)
 
   'xlWSh.Range("O4").Select
 
    'For Each fld In rst.Fields
    '    ApXL.ActiveCell = fld.Name
    '    ApXL.ActiveCell.Offset(0, 1).Select
    'Next
 
    rst.MoveFirst
    xlWSh.Range("P2").CopyFromRecordset rst
 
    xlWSh.Range("1:1").Select
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Arial"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
 
    'ApXL.Selection.Font.Bold = True
 
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
 
    ' selects all of the cells
    'ApXL.ActiveSheet.Cells.Select
 
    ' does the "autofit" for all columns
    'ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
 
    ' selects the first cell to unselect all cells
    'xlWSh.Range("E5").Select
 
    rst.Close
 
    Set rst = Nothing
    ApXL.ActiveWorkbook.Save
 
    ApXL.ActiveWorkbook.Close
 
Exit_SendToactivity:
 
    Exit Function
 
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SendToactivity
 
End Function

 

[Jeanette Cunningham]

You can hide the error message with some code in the err_handler.

Something like this:
'--------start code
err_handler: DoCmd.SetWarnings True
If Err.Number = 1234 Then
'do nothing
Else
MsgBox Err.Description, vbExclamation, Err.Number
End If
Resume Exit_SendToactivity
'-------end code

Note: replace 1234 with the error number you get when
the message about the file appears.