Convert to Excel 5_95 format

 

Download as .sbs Shows as plain text

 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
'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
Related pages

...

Navigate from here