' Данный скрипт создаёт из каждого текстового файла в папке по указанной маске (например, i*.txt) отдельный .sav-файл. ' Все .txt-файлы должны иметь один и тот же формат ' Автор: rlevesque@videotron.ca, 08.02.2003 ' Посетите мой сайт, посвящённый SPSS: http://www.spsstools.net Option Explicit Sub Main Dim strPath As String Dim strFilemask As String ' Исправьте следующие 2 строки в соответствии со своими задачами strPath ="c:\\temp\\" strFilemask ="I*.txt" Call CreateSavFiles(strPath, strFilemask) strFilemask="I*.sav" 'Закомментируйте следующую строку, если вы не хотите получить в конце общий .sav-файл, объединяющий содержимое всех текстовых файлов Call CombineDataFiles(strPath, strFilemask) End Sub Sub CreateSavFiles (strPath As String, strFilemask As String) ' Создаём один .sav-файл для каждого текстового файла Dim strFname As String Dim strCmd As String Dim intFileNb If InStr(strPath, "\\") = 0 Then 'путь не задан, используем текущий strPath = objSpssApp.GetSPSSPath End If If Len(strFilemask) = 0 Then 'маска имени файла не задана, используем *.txt strFilemask = "*.txt" End If 'Получим имя первого файла strFname = Dir$(strPath & strFilemask) While strFname <> "" strCmd = "GET FILE='" & strPath & strFname & "'." & vbCr strCmd = "DATA LIST FILE='" & strPath & strFname & "' LIST (TAB) SKIP=1 /event (F5.2) scl (F9.5)." & vbCr strCmd = strCmd & "STRING idstat(A6)." & vbCr strCmd = strCmd & "COMPUTE idstat='" & Mid(strFname,2,6) & "'." & vbCr strCmd = strCmd & "SAVE OUTFILE='" & strPath & Mid(strFname,1,InStr(strFname,".")-1) & ".sav'." & vbCr strCmd = strCmd & "EXECUTE." 'Debug.Print strCmd objSpssApp.ExecuteCommands strCmd , True 'Переходим к следюущему файлу strFname = Dir$() Wend End Sub Sub CombineDataFiles (strPath As String, strFilemask As String) 'Этот скрипт (а точнее - процедура) предназначен для того, чтобы объединять все .sav-файлы с именами по данноц маске (например, f*.sav) 'в указанной пользователем папке. Sav-файлы, которые вы объединяете, скорее всего, будут иметь одинаковые переменные, 'которые и будут сливаться, однако, скрипт работает и в том случае, если это не так. 'Скрипт создаёт в итоговом файле переменную, указывающую на источник данных (исходный файл). Метка 'этой переменной содержит путь к папке, откуда брались .sav-файлы, а метки значений - имена исходных 'файлов. ' Автор: rlevesque@videotron.ca, 02.10.2001 ' Приглашаю посетить мой веб-сайт по SPSS: http://www.spsstools.net Dim strFname As String Dim strCmd As String Dim intFileNb If InStr(strPath, "\\") = 0 Then 'путь не задан, испольльзуем текущий strPath = objSpssApp.GetSPSSPath End If If Len(strFilemask) = 0 Then 'макска имени не задана, используем *.sav strFilemask = "*.sav" End If 'Получим имя первого файла и загрузим его strFname = Dir$(strPath & strFilemask) strCmd = "GET FILE='" & strPath & strFname & "'." & vbCr strCmd = strCmd & "COMPUTE source=1." & vbCr strCmd = strCmd & "VALUE LABEL source 1 " & "'" & strFname & "'." & vbCr strCmd = strCmd & "VARIABLE LABEL source 'path=" & strPath & "'." & vbCr strCmd = strCmd & "EXECUTE." objSpssApp.ExecuteCommands strCmd , True 'Присоединяем к нему остальные файлы intFileNb = 2 While strFname <> "" strFname = Dir$() If strFname <> "" Then strCmd = "ADD FILES /FILE=* /FILE='" & strPath & strFname & "'." & vbCr strCmd = strCmd & "IF MISSING(source) source=" & intFileNb & "." & vbCr strCmd = strCmd & "ADD VALUE LABEL source " & intFileNb & " '" & strFname & "'." & vbCr strCmd = strCmd & "EXECUTE." Debug.Print strCmd objSpssApp.ExecuteCommands strCmd , True intFileNb = intFileNb + 1 End If Wend ' Сохраняем результирующий файл strCmd = "SAVE OUTFILE='" & strPath & "combined file.sav'." & vbCr strCmd = strCmd & "EXECUTE." objSpssApp.ExecuteCommands strCmd , True End Sub