Autopopulating Custom Fields via VBA

I know that VBA didn't ship with AutoCAD 2010, but it did with Civil 3D 2010. And since old habits are hard to break, I continue to use it.

As I have stated before, building the perfect template may involve customization outside the DWT file. Sometimes the perfect template contains custom project fields. Wouldn't it be nice to be able to autopopulate these fields in other drawings?

Configure a userform and associate text box to a field:

Private Sub ProjectFields()

Dim oProjectKey As String

Dim oProjectValue As String

oProjectKey = "Project" 'name of custom field

ThisDrawing.SummaryInfo.SetCustomByKey oProjectKey, oProject

End Sub

When you hit the OK button, not only does the value get assigned to a field, but it gets written out to an XML file:

Private Sub ExportXML()

Dim strFileName As String

Dim FSO

Dim oXML

Dim oProjectKey As String

Dim oProjectValue As String

oProjectKey = "Project" 'name of custom field

ThisDrawing.SummaryInfo.GetCustomByKey oProjectKey, oProjectValue

strFileName = ActiveDocument.Path + "\" + "Project.xml" 'writes file in active DWG directory

Set FSO = CreateObject("Scripting.FileSystemObject")

Set oXML = FSO.CreateTextFile(strFileName, True)

oXML.WriteLine ("")

oXML.WriteLine ("")

oXML.Write ("")

oXML.Write (oProjectValue)

oXML.Write ("")

oXML.WriteLine

oXML.WriteLine ("")

oXML.Close

End Sub

Now when the userform initializes, it would be nice if the text boxes were autopopulated with values from the XML if set previously in another drawing (this required loading up the Microsoft XML, v6 reference):

Dim fSuccess As Boolean

Dim FSO

Dim oXML As MSXML2.DOMDocument

Dim oRoot As MSXML2.IXMLDOMNode

Dim oChild As MSXML2.IXMLDOMNode

Dim oChildren As MSXML2.IXMLDOMNodeList

Dim oProjectKey As String

Dim oProjectValue As String

oProjectKey = "Project"

Set oXML = New MSXML2.DOMDocument

oXML.async = False

oXML.validateOnParse = False

fSuccess = oXML.Load(ActiveDocument.Path + "\Project.xml")

If Not fSuccess Then

GoTo ExitHere

End If

Set oXML = New MSXML2.DOMDocument

oXML.async = False

oXML.validateOnParse = False

fSuccess = oXML.Load(ActiveDocument.Path + "\Project.xml")

If Not fSuccess Then

GoTo ExitHere

End If

Set oRoot = oXML.documentElement

Set oChildren = oRoot.childNodes

For Each oChild In oChildren

If oChild.nodeName = "ProjectValue" Then

oProjectValue = oChild.nodeTypedValue

End If

Next oChild

ThisDrawing.SummaryInfo.SetCustomByKey oProjectKey, oProjectValue

ThisDrawing.SummaryInfo.GetCustomByKey oProjectKey, oProjectValue

MainDialog.Project.Text = (oProjectValue) 'puts value in pertaining textbox in userform

ExitHere:

End Sub

All of this code is available in various places on the web. Just thought I would bring it together in one place.