Конвертация всех файлов из папки в другой формат

 

Загрузить как .sbs Показать простым текстом

 

 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
Option Explicit
'Конвертация файлов в другой формат
'Файл для конвертации должны находиться в папке, указанной в переменной strPathS перед запуском скрипта
'Автор: Raynald Levesque, rlevesque@videotron.ca, 23.08.2003
'http://www.spsstools.net

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


Sub Main
	Dim strFname As String			'Имя файла
	Dim strPathS As String 	'Путь к источнику
	Dim strPathT As String 	'Путь к приёмнику
	Dim intCnt As Integer
	strPathT = "c:\\test2\\Chapter 2\\"
	strPathS = strPathT


	Debug.Clear
	'Конвертация .sav-файлов в .por-файлы
	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) 'удалим расширение
			Call convert (strFname, strPathS, strPathS, cSAVtoPOR)
	        strFname = Dir$()
	    Wend

		'Конвертация .por-файлов в .sav-файлы
		'strPathT = "c:\\test2\\"
		'strFname = Dir$(strPathS & "*.por")
		'While strFname <> ""
	     '   Debug.Print strFname
		'	strFname = Mid$(strFname, 1,InStrRev(strFname,".")-1)  'удалим расширение
		'	Call convert (strFname, strPathS,strPathT, cPORtoSAV)
	     '   strFname = Dir$()
	    'Wend

		'Конвертация .sav-файлов в .xls-файлы
		strFname = Dir$(strPathS & "*.sav")
		While strFname <> ""
	        Debug.Print strFname
			strFname = Mid$(strFname, 1,InStrRev(strFname,".")-1) 'удалим расширение
			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 & " конвертирован в .por"
	        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 & " конвертирован в .sav"
		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 & " конверитрован из .sav в .xls"
		Case Else 'не выполняем никаких действий
	End Select
End Sub
Related pages

...

Navigate from here