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