Экспорт меток из MS Access в SPSS

 

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

 

 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
'Это программа на VISUAL BASIC, которая должна бы быть конвертирована в VBA Access.
'Размещено в новостную группу SPSS. Автор: Thomas Zapf-Schramm <Thomas.Zapf-Schramm@home.ivm.de>, 7.4.2000
'Я долгое время использую SPSS и MS Access. Поскольку в MS Access нет меток переменных и значений в том смысле,
'в котором они есть в SPSS, мы ипользуем подстановочные ключевые таблицы, чтобы заменить эту возможность
'при составлении отчётов в БД или формах ввода данных. 
'Когда требуется перейти от данных в Access к данным в SPSS, мне требуется небольшая программа
'(выполняемая из БД Access, но её легко можно переделать на VB-скрипт или SAX Basic),
'которая конвертирует подстановочные таблицы в синтаксис SPSS, которые формирует желаемые метки в файле SPSS.
 
'Подстановочная таблица имеет 4 колонки: "Varname", "Varlabel", "Value" And "Vallabel". 
'В ней зафиксированы все возможные значения каждой переменной в основной таблице БД.
 
'Следующая процедура VBA нуждается в установлении ссылки на библиотеку "Microsoft scripting runtime" для доступа
'к объекту FileSystemObject.
 
 
Option Compare Database
Option Explicit
 
 
Public Sub MakeLabels(LabelTable As String, OutFileName As String)
    Dim aktDB As DATABASE
    Dim aktRS As Recordset
    Dim fs As New FileSystemObject
    Dim Outfile As TextStream
 
    Dim currVar As String
    Dim currVal As String
    Dim currVarlab As String
    Dim currValLab As String
    Dim lastVar As String
    Set aktDB = CurrentDb
    Set aktRS = aktDB.OpenRecordset(LabelTable, dbOpenDynaset)
    Set Outfile = fs.OpenTextFile(OutFileName, ForWriting, True)     
    aktRS.MoveFirst
    lastVar = ""
    Outfile.Write ("VARIABLE LABELS")
    Do While Not aktRS.EOF
        currVar = aktRS("Varname")
        currVarlab = aktRS("Varlabel")
        If currVar <> lastVar Then
            Outfile.WriteLine
            Outfile.Write ("  " & currVar & " '" & currVarlab & "'")         
        End If
        lastVar = currVar
        aktRS.MoveNext
    Loop
    Outfile.WriteLine (".")
    Outfile.WriteLine
    Outfile.Write ("VALUE LABELS")
    aktRS.MoveFirst
    lastVar = ""
    Do While Not aktRS.EOF
        currVar = aktRS("Varname")
        If lastVar <> "" Then currVar = "/" & currVar         
        currVal = CStr(aktRS("Value"))
        currValLab = aktRS("Vallabel")
        If currVar <> lastVar Then
            Outfile.WriteLine
            Outfile.WriteLine ("  " & currVar)
            Outfile.Write ("    " & Format(currVal, "0000") & " '" & currValLab & "'")         
        Else
            Outfile.WriteLine
            Outfile.Write ("    " & Format(currVal, "0000") & " '" & currValLab & "'")         
        End If
        If lastVar = "" Then currVar = "/" & currVar         
        lastVar = currVar
        aktRS.MoveNext
    Loop
    Outfile.WriteLine (".")
    aktRS.Close
    Outfile.Close
    Set aktRS = Nothing
    Set aktDB = Nothing
    Set Outfile = Nothing
    Set fs = Nothing
End Sub
Related pages

...

Navigate from here