Write XML to a file using Visual Basic

[Dan]

' Open the file to write XML data to it
Open strFileName For Output As intFileNum

' Create a string full of XML to output to the XML file
Print #intFileNum, "<WDObjects>" & vbCrLf & Chr(9) & "<WDDatabase>" &
vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & "<Description>Millennia</Description>"
& vbCrLf

GetDatabaseID

Print #intFileNum, Chr(9) & Chr(9) & "<ID>" & strDatabaseID & "</ID>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & "<Server>Dan</Server>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & "<WDDatabaseRights>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<AccessDatabase>True</AccessDatabase>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<AddDocuments>True</AddDocuments>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<AnnotateDocuments>True</AnnotateDocuments>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<CheckOutDocuments>True</CheckOutDocuments>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & "</WDDatabaseRights>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & "<WDCategory>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<AllowBlank>True</AllowBlank>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<ValueType>3</ValueType>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<ID>Tab</ID>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<Length>3</Length>" &
vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & "</WDCategory>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & "<WDCategory>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<AllowBlank>True</AllowBlank>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<ValueType>3</ValueType>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<ID>MGDocumentNumber</ID>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<Length>3</Length>" &
vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & "</WDCategory>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & "<WDCategory>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<AllowBlank>True</AllowBlank>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<ValueType>3</ValueType>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<ID>TenantNumber</ID>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<Length>3</Length>" &
vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & "</WDCategory>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & "<WDCategory>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<AllowBlank>True</AllowBlank>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<ValueType>200</ValueType>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<ID>PropertyName</ID>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<Length>255</Length>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & "</WDCategory>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & "<WDCategory>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<AllowBlank>True</AllowBlank>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<ValueType>200</ValueType>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<ID>ClosingBinderName</ID>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<Length>255</Length>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & "</WDCategory>" & vbCrLf

Print #intFileNum, Chr(9) & Chr(9) & "<WDFolder>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<Description>" & ParseSpecialChars(adoFldPropertyName.Value)
& "</Description>" & vbCrLf

Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "<WDFolder>" & vbCrLf

' Loop through the records within the DocTypeTable
Do While Not adoDocTypeTableRS.EOF
' Compare two values to see if they coincide with one another
' Does the name in this table match the name in that table?
If adoFldDocTypeName.Value = adoFldDocumentDocTypeName.Value Then
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<Description>"
& ParseSpecialChars(adoFldDocTypeName.Value) & "</Description>" & vbCrLf
End If
' Move to the next record within the DocTypeTable
adoDocTypeTableRS.MoveNext
Loop

' Move to the first record within the DocTypeTable
adoDocTypeTableRS.MoveFirst

Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<WDFolder>" &
vbCrLf

' Loop through the records within the ClosingBinderTable
Do While Not adoClosingBinderTableRS.EOF
' Compare two values to see if they coincide with one another
' Does the number in this table match the number in that table?
If adoFldClosingBinderNumber.Value = adoFldDocumentClosingBinderNumber.Value
Then
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9)
& "<Description>" & ParseSpecialChars(adoFldClosingBinderName.Value) & "</Description>"
& vbCrLf
End If
' Move to the next record within the ClosingBinderTable
adoClosingBinderTableRS.MoveNext
Loop
' Move to the first record within the ClosingBinderTable
adoClosingBinderTableRS.MoveFirst

' Check to see if the user supplied the
' program with a path to the pdf documents
If PathToPDFDocuments <> "" Then
' Obtain a user specified value
' of the path to the pdf documents
GetPDFPath
Else
' To Do: Write some error handling stuff
End If

' Loop through each record within the DocumentTable
Do While Not adoDocumentTableRS.EOF
adoDocumentTableRS.RecordCount
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & "<WDDocument>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9)
& "<Title>" & ParseTitleChars(adoFldDocumentName.Value) & "</Title>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9)
& "<FilePath>" & strPDFPath & adoFldDocumentNumber.Value & ".pdf" & "</FilePath>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9)
& "<MimeType>" & "application/pdf" & "</MimeType>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9)
& "<ID>" & adoFldDocumentTab.Value & "</ID>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9)
& "<WDCategory>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9)
& Chr(9) & "<Tab>" & adoFldDocumentTab.Value & "</Tab>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9)
& Chr(9) & "<MGDocumentNumber>" & adoFldDocumentNumber.Value & "</MGDocumentNumber>"
& vbCrLf

' Check to see if the DocumentPropertyNumber is not equal to
0
If adoFldDocumentPropertyNumber <> 0 Then
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9)
& Chr(9) & Chr(9) & "<PropertyName>" & ParseSpecialChars(adoFldPropertyName.Value)
& "</PropertyName>" & vbCrLf
End If
' Check to see if the DocumentTenantNumber is not equal to 0
If adoFldDocumentTenantNumber <> 0 Then
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9)
& Chr(9) & Chr(9) & "<TenantName>" & ParseSpecialChars(adoFldTenantName.Value)
& "</TenantName>" & vbCrLf
End If
' Check to see if the DocumentClosingBinderNumber is not equal
to 0
If adoFldDocumentClosingBinderNumber <> 0 Then
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9)
& Chr(9) & Chr(9) & "<ClosingBinderName>" & ParseSpecialChars(adoFldClosingBinderName.Value)
& "</ClosingBinderName>" & vbCrLf
End If

Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9)
& "</WDCategory>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & "</WDDocument>"
& vbCrLf
' Move to the next record with the DocumentTable
adoDocumentTableRS.MoveNext
Loop

Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & Chr(9) & "</WDFolder>"
& vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & Chr(9) & "</WDFolder>" & vbCrLf
Print #intFileNum, Chr(9) & Chr(9) & "</WDFolder>" & vbCrLf

Print #intFileNum, Chr(9) & "</WDDatabase>" & vbCrLf & "</WDObjects>"

' Close the XML file
Close intFileNum

[Craig Clearman]

Dan,

Is there a question buried in that code? If so, perhaps you better
highlight it.

Ciao, Craig

[David]

I thought that the easiest way to write an XML file is by using the recordset
save method:

Dim file_name as string
file_name = "c:\xml\xml_tst.xml"
Dim rs as recordset
'--establish connection
'--open the recordset

Rs.save "file_name", adPersistXML


And the XML file is created with no other work. This requires ADO 2.5

David