Объединить все .sav-файлы из заданной папки
Пользователь указывает путь и маску имени файла, скрипт делает остальное… В итоговый .sav-файл добавляется переменная, указывающая на файл-источник записей
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 | 'Этот скрипт предназначен для того, чтобы объединять все .sav-файлы с именами по данноц маске (например, f*.sav) 'в указанной пользователем папке. Sav-файлы, которые вы объединяете, скорее всего, будут иметь одинаковые переменные, 'которые и будут сливаться, однако, скрипт работает и в том случае, если это не так. 'Скрипт создаёт в итоговом файле переменную, указывающую на источник данных (исходный файл). Метка 'этой переменной содержит путь к папке, откуда брались .sav-файлы, а метки значений - имена исходных 'файлов. ' Автор: rlevesque@videotron.ca, 02.10.2001 ' Приглашаю посетить мой веб-сайт по SPSS: http://www.spsstools.net Option Explicit Sub Main Dim strPath As String Dim strFileMask As String ' Измените следующие 2 строки по своим надобностям strPath ="c:\\temp\\" strFileMask ="f*.sav" Call CombineDataFiles(strPath, strFileMask) End Sub Sub CombineDataFiles (strPath As String, strFileMask As String) 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 |
Related pages
...