A97 Rst to XLS on Office 2007 client

[GaryS]

Beginning a transition from Office97 to Office 2007 (installed on
Windows XP). We have numerous Access97 MDBs distributed as runtimes to
client PCs. For Phase I testing, on one client PC I have removed
Office97 Standard and have installed Office 2007 Standard, retaining
the A97 runtime. Objective here is to test existing A97 applications
on the 2007 client.

The A97 app in question is split into front and back ends. Behind many
command buttons in this app I open a recordset and copy to Excel.

On the 2007 test client, the worksheet opens correctly and saves using
the file name I've provided. But I'm getting the following error:
"SaveAs method of Workbook class failed." Beyond the message,
everything appears to have worked correctly - even the file extension
is XLS (that's good).

My code uses late binding, I think. Can anyone see what might be
causing the error?

**************************

Sub CreateExcel_Spr()

Dim xlApp As Object
Dim xlObject As Object
Dim ws As Object
Dim i As Integer

Dim db As DAO.Database, rs As DAO.Recordset

'Error Handler to confirm whether Excel is already running
On Error GoTo startExcel
Set xlApp = GetObject(, "Excel.application.")
Exit Sub

startExcel:
If err.Number = 429 Then

Set db = DBEngine.Workspaces(0).Databases(0)
Set rs = db.OpenRecordset(strQryXls, dbOpenDynaset)

Set xlApp = CreateObject("Excel.Application")
Set xlObject = xlApp.Workbooks.Add

strNameXls = "PVRextract"

Set ws = xlObject.Worksheets(1)
ws.Activate
xlApp.Visible = True
Else
MsgBox err.Description
End If


'Loop through field names and create Excel headings
For i = 0 To rs.Fields.Count - 1
ws.Cells(1, i + 1).Value = rs.Fields(i).Name
Next i

'Format headers bold font
ws.Range(ws.Cells(1, 1), ws.Cells(1, rs.Fields.Count)).Font.Bold =
True

'Get data from recordset and copy to worksheet
ws.Range("A2").CopyFromRecordset rs

ws.Activate

ws.Name = strNameXls

ws.Cells.Select
ws.Cells.EntireColumn.AutoFit
ws.Range("A1").Select

'*******************
'Error handler for SaveAs XLS
On Error GoTo Err_CreateExcel

strPath = "F:\Excel\"

xlApp.ActiveWorkbook.SaveAs Filename:=strPath & strNameXls

strNameXls = ""
strPath = ""
'**********************************

Exit_CreateExcel:

Set rs = Nothing
Set db = Nothing
Set ws = Nothing
Set xlApp = Nothing
Set xlObject = Nothing

Exit Sub

Err_CreateExcel:
MsgBox err.Description
Resume Exit_CreateExcel

End Sub

 

[GaryS]

Problem resolved. The test PC was not configured correctly. Network
SaveAs path did not exist. Mapped the drive and it works much better
that way. Anyway, thanks for reading the post.

 

[RoyVidar]

Problem resolved. The test PC was not configured correctly. Network
SaveAs path did not exist. Mapped the drive and it works much better
that way. Anyway, thanks for reading the post.

If you run into issues with previous versions not able to read what
you save etc, perhaps you'd like a look here
http://www.rondebruin.nl/saveas.htm

if val(xlapp.version)<12 then
TheWorkbook.SaveAs Filename:=strPath & strNameXls, FileFormat:=-4143
else
TheWorkbook.SaveAs Filename:=strPath & strNameXls, FileFormat:=56
endif

FileFormat 56 means xlExcel8, which is 97-2003 format from Excel 2007