' The output metadata document (.mdd) file
#define OUTPUTMDM "C:\Program Files\IBM\SPSS\DataCollection\7\DDL\Output\museum2.mdd"

' Copy the museum.mdd sample file so that we
' do not update the original file...
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile("C:\Program Files\IBM\SPSS\DataCollection\7\DDL\Data\Data Collection File\museum.mdd", _
OUTPUTMDM, True)

' Make sure that the read-only attribute is not set
Set f = fso.GetFile(OUTPUTMDM)
If f.Attributes.BitAnd(1) Then
f.Attributes = f.Attributes - 1
End If

Dim MyDocument, M2Q, MyDataSource

' Create the MDM object and open the .mdd file in read-write mode
Set MyDocument = CreateObject("MDM.Document")
MyDocument.Open(OUTPUTMDM, , MDMLib.openConstants.oREADWRITE)

' Check whether a Quantum DSC DataSource object already exists

On Error Resume Next
Set MyDataSource = MyDocument.DataSources.Find("mrpunchdsc")
If MyDataSource Is Null Then
' Create a Quantum DSC DataSource object if one doesn't already exist
Set MyDataSource = MyDocument.DataSources.AddNew("mrPunchDsc", _
"mrPunchDsc", "MyDatFile.dat")
End If
Set MyDocument.DataSources.Current = MyDataSource
Err.Clear()
On Error Goto 0

' Create the MDM2Quantum object
Set M2Q = CreateObject("MDM2QuantumLib.MDM2Quantum")

' Set the MDM Document into the MDM2Quantum object
Set M2Q.MDMDocument = MyDocument

On Error Resume Next ' Use custom error handling for ClearCardColPunch
Err.Clear()

' Clear any existing card and column custom properties
M2Q.ClearCardColPunch()

' MDM2QuantumLib.ErrorConstants.ERR_CANNOT_REMOVE_SYS_VAR = &H8004020B
' MDM2QuantumLib.ErrorConstants.ERR_CANNOT_REMOVE_REGULAR_VAR = &H80040213
If Err.Number <> 0 Then
If Err.Number = &H8004020B Then ' We can safely ignore this error
Debug.Log(CText(Err.LineNumber) + ": " + Err.Description)
Err.Clear()
ElseIf Err.Number = &H80040213 Then ' We need to add a new version and clear again
MyDocument.Versions.AddNew()
M2Q.ClearCardColPunch()
Err.Clear()
Else
Exit
End If
End If

On Error Goto 0 ' Use standard error handling again

' Set the MDM2Quantum properties to use the standard Quantum
' setting of multiple cards with 80 columns. Delete these lines
' if you want to use one card of unlimited length
M2Q.SerialFullName = "Respondent.Serial"
M2Q.SerialColCount = 5
M2Q.CardNumColCount = 2
M2Q.CardNumColStart = 6
M2Q.CardSize = 80

M2Q.AllocateCardColPunch(True)

' Save the MDM Document.
MyDocument.Save()
MyDocument.Close()