workbook.saveas method problem

[ChrisOswald]

Automating Excel from Access, I'm attempting to generate a single sheet workbook and save to a Sharepoint site. This process works fine on my machine (XL2007, XP), but on a coworkers computer (XL2003, XP), the code throws a 1004 error on the save as line. However, the really odd thing is that stepping through the code doesn't throw an error on the coworkers machine. Any ideas on what might be causing this behavior? Here's the sub being ran; the line it errors out on is the first branch in the .saveas block.

Private Const csSharePointSaveAs = "[URL="file://\\sharepoint-us.mycompany.com\sites\finance"]\\sharepoint-us.mycompany.com\sites\finance[/URL] admin\blah blah\blah-blah\Customer Publication Tracking.xls"
 
 
Private Sub PublishXLtoMOSS()
    Dim objXL                           As Excel.Application    'Object
    Dim wb                              As Excel.workbook    'Object
    Dim ws                              As Excel.Worksheet    'Object
    Dim rs                              As DAO.Recordset
    Dim i                               As Long
 
    'Set objXL = CreateObject("Excel.Application")
    Set objXL = New Excel.Application
    'objXL.Visible = True
    Set wb = objXL.Workbooks.Add(-4167)    'xlWBATWorksheet
    Set ws = wb.Worksheets(1)
    Set rs = CurrentDb.OpenRecordset("tblPublicationCheckPoints")
    rs.MoveFirst
    For i = 0 To rs.Fields.Count - 1
        ws.Cells(1, i + 1) = rs.Fields(i).Name
    Next i
    ws.Cells(2, 1).CopyFromRecordset rs
    rs.Close
    Set rs = Nothing
    ws.Cells.EntireColumn.AutoFit
    objXL.DisplayAlerts = False
    If Val(objXL.Version) < 12 Then
        'Here's the line with the odd error...
        wb.saveas Filename:=csSharePointSaveAs, FileFormat:=-4143
    Else
        wb.saveas Filename:=csSharePointSaveAs, FileFormat:=56    'xl 98-03 fileformat
    End If
    wb.Close savechanges:=False
    Set ws = Nothing
    Set wb = Nothing
    objXL.DisplayAlerts = True
    objXL.Quit
End Sub

 

[ChrisOswald]

I came up with a fix. I'm not sure how stable it is, but, then again, I don't really know what is the cause of my problem.

I just wrote an error handler around the .saveas block. When there's a failure to save, it tries to save it again, up to 5 times. It seems to always work on the second .saveas attempt to the sharepoint site.

Private Sub PublishXLtoMOSS()
    Dim objXL                           As Object    'Excel.Application
    Dim wb                              As Object    'Excel.workbook
    Dim ws                              As Object    'Excel.Worksheet
    Dim rs                              As DAO.Recordset
    Dim i                               As Long
    Dim lSaveFails                      As Long
    Dim newHour                         As Integer
    Dim newMinute                       As Integer
    Dim newSecond                       As Integer
    Dim waitTime                        As Date
    Set objXL = CreateObject("Excel.Application")
    'Set objXL = New Excel.Application
    'objXL.Visible = True
    Set wb = objXL.Workbooks.Add(-4167)    'xlWBATWorksheet
    Set ws = wb.Worksheets(1)
    Set rs = CurrentDb.OpenRecordset("tblPublicationCheckPoints")
    rs.MoveFirst
    For i = 0 To rs.Fields.Count - 1
        ws.Cells(1, i + 1) = rs.Fields(i).Name
    Next i
    ws.Cells(2, 1).CopyFromRecordset rs
    rs.Close
    Set rs = Nothing
    ws.Cells.EntireColumn.AutoFit
    objXL.DisplayAlerts = False
 
    On Error GoTo TrySaveAgain
    If Val(objXL.Version) < 12 Then
        wb.saveas Filename:=pcsSharePointSaveAs, FileFormat:=-4143
    Else
        wb.saveas Filename:=pcsSharePointSaveAs, FileFormat:=56    'xl 98-03 fileformat
    End If
    On Error GoTo 0
    wb.Close savechanges:=False
    Set ws = Nothing
    Set wb = Nothing
    objXL.DisplayAlerts = True
    objXL.Quit
    'on testing, the msgbox below seemed to always give the number of save failures as 1,
    'I have no idea why trying to do this twice works...
    'MsgBox "Savefail attempts: " & lSaveFails
    Exit Sub
TrySaveAgain:
    lSaveFails = lSaveFails + 1
    If lSaveFails = 5 Then
        'At some point, give up...
        MsgBox ("File not updated in Sharepoint")
        Err.Clear
        Resume Next
    Else
        'not really certain if this delay is necessary, but what the heck.
        newHour = Hour(Now())
        newMinute = Minute(Now())
        newSecond = Second(Now()) + 2
        waitTime = TimeSerial(newHour, newMinute, newSecond)
        objXL.wait (waitTime)
        Err.Clear
        Resume
    End If
End Sub