'Save this As "Convert to Excel 5/95 format.SBS" 'Begin DESCRIPTION ' To load an xls file (Format 2.1) and save it in Excel 5/95 Format. ' this may be called by syntax using a line such as ' SCRIPT "c:\\temp\\Convert to Excel 5_95 format.SBS" ("c:\\temp\\test.xls"). 'End DESCRIPTION 'Posted to SPSSX-L list on 2001/07/13 by rlevesque@videotron.ca Const xlExcel5 = 39 Sub Main Dim strFileName As String strFileName = GetFileName Call SaveToExcel5(strFileName) End Sub Sub SaveToExcel5(strFileName As String) Dim objExcelApp As Object On Error GoTo Oopps ' GetObject returns a reference to an existing app ' if none exists, an error will result and excel will be instanciated Set objExcelApp = GetObject(,"Excel.Application") objExcelApp.Workbooks.Open strFileName If strFileName = "" Then Exit Sub ' User did not supply a file name, we exit objExcelApp.AlertBeforeOverwriting = False strFileName = Left(strFileName,Len(strFileName)-4) & "v5.xls" objExcelApp.ActiveWorkbook.SaveAs FileName:=strFileName, FileFormat:=xlExcel5 objExcelApp.ActiveWorkbook.Close Set objExcelApp = Nothing Exit Sub Oopps: Select Case Err Case 10096 Debug.Print "Excel is not running, use CreateObject" 'CreateObject starts Excel when it's not already running. If objExcelApp Is Nothing Then Set objExcelApp = CreateObject("Excel.Application") End If Resume Next Case Else Debug.Print Err & " " & Err.Description End Select End Sub Function GetFileName() As String Dim strFileName As String 'First check to see if the script was invoked from syntax, 'and a filename is provided as a script parameter. On Error Resume Next 'the following will cause an error in SPSS 7.5 strFileName = objSpssApp.ScriptParameter(0) If Err Then Err.Clear End If If strFileName <> "" Then GetFileName = strFileName Exit Function End If 'If there wasn't a script parameter, get the filename from the user Do '0=User must select an existing file strFileName = GetFilePath$("*.xls","xls",,"File to convert to Excel 5", 0) If strFileName = "" Then 'user cancelled GetFileName = "" Exit Function End If Loop Until strFileName <> "" GetFileName = strFileName End Function