Export labels from MS Access to SPSS

 

Download as .txt Shows as plain text

 

 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
'This is a VISUAL BASIC program, it would have to be converted to VBA access.
'Posted in newsgroup by Thomas Zapf-Schramm <Thomas.Zapf-Schramm@home.ivm.de> on 2000/04/07 
'I'm working for years with SPSS amd MS Access. Because MS-Access has no labels in the SPSS sense we 
'use lookup-tables to substitute this feature in database reports or data entry forms. 
'When I go from Access To SPSS I need a tiny Visual Basic program
'(In the Access database, but it could easily be converted To VB script Or SAX Basic) 
'that converts the lookup-table To a SPSS-Syntax file which generates the desired labels.
 
'The lookup-table has four columns: "Varname", "Varlabel", "Value" And "Vallabel". 
'It has an entry for each possible value of each variable in the main database table.
 
'The following VBA program needs a reference to the "Microsoft scripting runtime" for the filesystem Object.
 
 
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