How to create a new XML file

This code creates an empty XML document, "New_XML_Document", within the selected folder. This new XML document may then be used as the foundation for a metadata template, to hold static information for an organization such as address and distribution methods which in turn may be applied to various data. The new XML document may also represent metadata for data stored on media, such as a paper map collections or legacy data stored on CDs. The XML document can then be published to a ArcIMS Metadata Service, as a means of data discovery.

This macro doesn't verify that the selected object supports metadata, whether it already has metadata, or whether the metadata is writable.

How to use

Paste this macro into VBA.
Select an object in ArcCatalog that has metadata.
Run the macro.

[VBA]


        Sub newXMLFile()
    
    Dim pGxApp As IGxApplication
    Dim pGxObj As IGxObject
    Set pGxApp = Application
    Set pGxObj = pGxApp.SelectedObject
    If TypeOf pGxObj Is IGxFolder Then
        
        Dim sName As String
        sName = "New_XML_Document"
        
        Dim lCnt As Long
        lCnt = 0
        
        Dim pGxCnt As IGxObjectContainer
        Set pGxCnt = pGxObj
        If pGxCnt.HasChildren Then
            
            Dim pGxChldEn As IEnumGxObject
            Dim pGxChld As IGxObject
            Set pGxChldEn = pGxCnt.Children
            On Error Resume Next
            Set pGxChld = pGxChldEn.Next
            Do While Not pGxChld Is Nothing
                If Left(pGxChld.Name, 16) = sName Then lCnt = lCnt + 1
                Set pGxChld = pGxChldEn.Next
            Loop
        End If
        If lCnt > 0 Then sName = sName & "(" & lCnt & ")"
        
        Dim pGxFile As IGxFile
        Set pGxFile = New GxMetadata
        pGxFile.Path = pGxObj.FullName & "\" & sName & ".xml"
        
        Dim pMD As IMetadata
        Set pMD = pGxFile
        
        Dim pXPS As IXmlPropertySet
        Set pXPS = New XmlPropertySet
        pMD.Metadata = pXPS
        
        pGxObj.Refresh
        
    End If
    
End Sub