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
81
82
Option Explicit
'You need files in the strPathS folder for this script to work
'Raynald Levesque rlevesque@videotron.ca 2003/08/23
'http://pages.infinit.net/rlevesqu/index.htm

Const cSAVtoPOR As Integer =1
Const cPORtoSAV As Integer =2
Const cSAVtoXLS As Integer =3


Sub Main
	Dim strFname As String			'File name
	Dim strPathS As String 	'Path of Source
	Dim strPathT As String 	'Path of Target
	Dim intCnt As Integer
	strPathT = "c:\\test2\\Chapter 2\\"
	strPathS = strPathT


	Debug.Clear
	'Convert sav files into por files
	For intCnt = 2 To 11
		strPathS = "c:\\test2\\Chapter " & intCnt & "\\"
		strFname = Dir$(strPathS & "*.sav")
		While strFname <> ""
	        Debug.Print strFname
			strFname = Mid$(strFname, 1,InStrRev(strFname,".")-1) 'remove extension
			Call convert (strFname, strPathS, strPathS, cSAVtoPOR)
	        strFname = Dir$()
	    Wend

		'Convert por files into sav files in "c:\\test2\\" folder
		'strPathT = "c:\\test2\\"
		'strFname = Dir$(strPathS & "*.por")
		'While strFname <> ""
	     '   Debug.Print strFname
		'	strFname = Mid$(strFname, 1,InStrRev(strFname,".")-1)  'remove extension
		'	Call convert (strFname, strPathS,strPathT, cPORtoSAV)
	     '   strFname = Dir$()
	    'Wend

		'Convert sav files into xls files


		strFname = Dir$(strPathS & "*.sav")
		While strFname <> ""
	        Debug.Print strFname
			strFname = Mid$(strFname, 1,InStrRev(strFname,".")-1) 'remove extension
			Call convert (strFname, strPathS,strPathS, cSAVtoXLS)
	        strFname = Dir$()
	    Wend
	Next
End Sub


Sub convert (F As String, strPathS As String ,strPathT As String , intType As Integer)
Dim strCmd As String
Dim objSPSSDataDoc As ISpssDataDoc
	Select Case intType
		Case cSAVtoPOR
			Set objSPSSDataDoc=objSpssApp.OpenDataDoc (strPathS & F & ".sav")
	        objSPSSDataDoc.Visible=True
			strCmd = "EXPORT OUTFILE='" & strPathT & F & ".por'." & vbCrLf
			objSpssApp.ExecuteCommands (strCmd,True)
	        Debug.Print F & " was converted to por format"
	        Set objSPSSDataDoc = Nothing
		Case cPORtoSAV
			strCmd = "IMPORT FILE='" & strPathS & F & ".por'." & vbCrLf
			strCmd = strCmd & "SAVE OUTFILE='" & strPathT & F & ".sav'." & vbCrLf
			objSpssApp.ExecuteCommands (strCmd,True)
	        Debug.Print F & " was converted to sav format"
		Case cSAVtoXLS
			strCmd = strCmd & "SAVE TRANSLATE OUTFILE='" & strPathS & F & ".xls'" & vbCrLf
			strCmd = strCmd & "  /TYPE=XLS /VERSION=8 /MAP /REPLACE /FIELDNAMES" & vbCrLf
			strCmd = strCmd & "  /CELLS=LABELS ." & vbCrLf
			objSpssApp.ExecuteCommands (strCmd,True)
	        Debug.Print F & " was converted from sav to xls format"
		Case Else 'nothing to do

	End Select

End Sub