Export Data Dictionary to text files

'GENERAL DESCRIPTION
'
'This script allows a user to export complete dictionary information of active spss
'file to text files.
'
'
'REQUIREMENTS: SPSS data file must be opened in the data editor
'
'PURPOSE:
'If you run this script, you can import text files into MS Access or MS Excel.
'You can create a database of your variables names and formats in Access. It is particulary
'useful when you have a lot of variables. Also, you can create report in order to print
'your data dictionary in a specific format.
'
'AUTHORS:
'Name: Jean-Francois Allaire, Centre de recherche Philippe Pinel de Montreal
'E-Mail: jfallaire@ssss.gouv.qc.ca
'This script combine and improve the scripts below.
'Script: Export variable and value labels to txt files.SBS (Wouter Egberink sent this code to Raynald's web site)
'Script: Export variable name and variable labels to text file.SBS (Raynald Levesque)
'Script: Display number of variables and cases in data file.SBS (Raynald Levesque)
'
'DATE: 2002/07/18
'
'RESULTS: Data dictionary is saved in four different text files on the 'C:\\' directory. See below the
'         description of each text files. The fields in these text files are seperated by the ";" symbol.
'
'TEXT FILES DESCRIPTION (FIELDS):
'
'File:Fileinfo.txt
'SPSSFilename;Numberofcases;Numberofvariables
'
'File:valuelabel.txt
'Variablename;Valuenumber;Valuelabel;
'
'File:variablesinfo.txt
'SPSSFilename;Variableposition;Variablename;Variablelabel;Variabletype;Variablewidth;Numberofdecimals;
'Numberofusermissingvalues;Missingvalue1;Missingvalue2;Missingvalue3
'
'File:Dictionary.txt
'SPSSFilename;Variableposition;Variablename;Variablelabel;Variabletype;Variablewidth;Numberofdecimals;
'Numberofusermissingvalues;Missingvalue1;Missingvalue2;Missingvalue3;Valuenumber1;Valuelabel1;Valuenumber2;Valuelabel2;
'Valuenumber3;Valuelabel3;etc....
'
'Format type return values:
'1	SpssPrintFormatA
'2	SpssPrintFormatAhex
'3	SpssPrintFormatComma
'4	SpssPrintFormatDollar
'5	SpssPrintFormatF
'6	SpssPrintFormatIb
'7	SpssPrintFormatPibhex
'8	SpssPrintFormatP
'9	SpssPrintFormatPib
'10	SpssPrintFormatPk
'11	SpssPrintFormatRb
'12	SpssPrintFormatRbhex
'15	SpssPrintFormatZ
'16	SpssPrintFormatN
'17	SpssPrintFormatE
'20	SpssPrintFormatDate
'21	SpssPrintFormatTime
'22	SpssPrintFormatDatetime
'22	SpssPrintFormatDatetime
'23	SpssPrintFormatAdate
'24	SpssPrintFormatJdate
'25	SpssPrintFormatDtime
'26	SpssPrintFormatWkday
'27	SpssPrintFormatMonth
'28	SpssPrintFormatMoyr
'29	SpssPrintFormatQyr
'30	SpssPrintFormatWkyr
'31	SpssPrintFormatPct
'32	SpssPrintFormatDot
'33	SpssPrintFormatCca
'34	SpssPrintFormatCcb
'35	SpssPrintFormatCcc
'36	SpssPrintFormatCcd
'37	SpssPrintFormatCce
'38	SpssPrintFormatEdate
'39	SpssPrintFormatSdate
'*****************************************************************************

Option Explicit
Sub Main
Dim objSPSSInfo As ISpssInfo,ValueLabels()
Dim objDataDoc As ISpssDataDoc
Dim LongValString As String, K As Long,I As Long,J As Long
Dim NumVars As Long             'Number of variables
Dim VarName As String           'Variable name
Dim VarLabel As String          'Variable label
Dim NumVals As Long             'Number of value labels
Dim ValName As String           'Value number
Dim ValLabel As String          'Description of Value label
Dim strDataName As String		'Name of data file
Dim lngNumCases As Long			'Number of cases
Dim vrtVarType As Variant       'Variable type
Dim vrtVarWidth As Variant      'Variable Width
Dim vrtVarFract As Variant      'Number of decimals
Dim vrtMissingCounts As Variant 'Number of user missing values'
Dim vrtMissingValues As Variant 'Missing values

Set objSPSSInfo = objSpssApp.SpssInfo
Set objDataDoc = objSpssApp.Documents.GetDataDoc(0)

strDataName = objDataDoc.GetBannerText  	'Name of data file
lngNumCases = objDataDoc.GetNumberOfCases 	'Number of cases

objDataDoc.GetVariableFormats(vrtVarType, vrtVarWidth, vrtVarFract) 'Variable Formats
objDataDoc.GetVariableMissingValues(vrtMissingCounts, vrtMissingValues) 'Missing values

Open "C:\\variablesinfo.txt" For Output As #1
Open "C:\\valuelabel.txt" For Output As #2
Open "C:\\Dictionary.txt" For Output As #3
Open "C:\\Fileinfo.txt" For Output As #4


NumVars=objSPSSInfo.NumVariables-1

 'Print file information
  Print #4, strDataName & ";" & lngNumCases & ";" & NumVars+1

For I=0 To NumVars
  VarName= objSPSSInfo.VariableAt(I)
  VarLabel= objSPSSInfo.VariableLabelAt(I)
  If Len(VarLabel)=0 Then
      VarLabel=VarName
  End If
  'Print variableinfo file
  Print #1, strDataName & ";" & I+1 & ";" & VarName & ";" & VarLabel & ";" & vrtVarType(I) & ";" & vrtVarWidth(I) & ";" & vrtVarFract(I)& ";" & vrtMissingCounts(I) & ";" & vrtMissingValues(I, 0) & ";" & vrtMissingValues(I, 1) & ";" & vrtMissingValues(I, 2)
  LongValString = CStr(strDataName) & ";" & CStr(I+1) & ";" & CStr(VarName) & ";" & CStr(VarLabel) & ";" & CStr(vrtVarType(I)) & ";" &  CStr(vrtVarWidth(I)) & ";" & CStr(vrtVarFract(I)) & ";" & CStr(vrtMissingCounts(I)) & ";" & CStr(vrtMissingValues(I,0)) & ";" & CStr(vrtMissingValues(I,1)) & ";" & CStr(vrtMissingValues(I,2))
  NumVals= objSPSSInfo.NumberOfValueLabels(I)-1
  For K=0 To NumVals
      ValName= objSPSSInfo.ValueAt(I,K)
      ValLabel= objSPSSInfo.ValueLabelAt(I,K)
      If Len(ValLabel)=0 Then
           ValLabel=ValName
      End If
      'Print valuelabel file
      Print #2, VarName & ";" & ValName & ";" & ValLabel
      LongValString = LongValString & ";" & CStr(ValName) & ";" & CStr(ValLabel)
  Next K
 'Print dictionary file
  Print #3, LongValString
Next I
Set objSPSSInfo = Nothing
Close #1
Close #2
Close #3
Close #4
End Sub