Attribute VB_Name = "FSG"
Sub WriteXML()
Attribute WriteXML.VB_ProcData.VB_Invoke_Func = "m\n14"

    'Created:   2006 MAY
    'Creator:   Shane Walker, EIT
    '           Center for Research in Water Resources (CRWR)
    '           Environmental and Water Resources Engineering (EWRE)
    '           The University of Texas at Austin
    
    'This application creates an XML geodatabase schema to be imported into an ESRI geodatabase using the Geodatabase Designer 2 toolbar.

    
    Dim fso As New FileSystemObject
    Dim ts As TextStream
    Dim filename As String
    Dim message As String
    Dim c_month, c_day, c_hour, c_second As String  'metadata: creation date components
    Dim n As Integer            'counter
    Dim stfield As String       'subtype field
    Dim stcode As String        'default subtype code
    
    
    'XML file location and name
    filename = InputBox("Please input the XML path and filename.", "XML Filename", "C:\FSG_geodatabase_schema.xml")
    If filename = "" Then GoTo 9999
    Set ts = fso.CreateTextFile(filename, True, True)


    'Header
    ts.WriteLine "<?xml version=""1.0"" encoding=""UTF-16"" standalone=""no""?>"
    ts.WriteLine "<?xml-stylesheet type=""text/xsl"" href=""C:\Program Files\ArcGIS\Geodatabase Designer 2\XSL\Geodatabase Designer.xsl""?>"
    ts.WriteLine "<geodatabaseDesigner version=""2.0.345"">"


    'Metadata
    ts.WriteLine "      <metadata>"
    If Len(month(Now)) = 1 Then
        c_month = "0" & month(Now)
    Else: c_month = month(Now)
    End If
    If Len(day(Now)) = 1 Then
        c_day = "0" & day(Now)
    Else: c_day = day(Now)
    End If
    If Len(hour(Now)) = 1 Then
        c_hour = "0" & hour(Now)
    Else: c_hour = hour(Now)
    End If
    If Len(Minute(Now)) = 1 Then
        c_minute = "0" & Minute(Now)
    Else: c_minute = Minute(Now)
    End If
    If Len(second(Now)) = 1 Then
        c_second = "0" & second(Now)
    Else: c_second = second(Now)
    End If
    ts.WriteLine "              <creationDate year=""" & year(Now) & """ month=""" & c_month & """ day=""" & c_day & """ hour=""" & c_hour & """ minute=""" & c_minute & """ second=""" & c_second & """/>"
    ts.WriteLine "              <creator user=""creator user"" computer=""computer""/>"
    ts.WriteLine "              <geodatabase esriWorkspaceType=""1"" flavor=""Access"" version=""2.0.1"">"
    ts.WriteLine "                      <connectionProperty name=""DATABASE"" value=""""/>"
    ts.WriteLine "              </geodatabase>"
    ts.WriteLine "      </metadata>"


    'Domains
    Worksheets("Domains").Activate
    Range("A4").Select
    Do Until Selection = ""
        ts.WriteLine "  <domain name=""" & Selection & """ description=""" & ActiveCell.Offset(0, 2) & """ owner="""" esriDomainType=""2"" esriFieldType=""0"" esriMergePolicyType=""3"" esriSplitPolicyType=""3"">"
        ActiveCell.Offset(1, 1).Select
        Do Until Selection = ""
            ts.WriteLine "              <member name=""" & ActiveCell.Offset(0, 1) & """ value=""" & Selection & """/>"
            ActiveCell.Offset(1, 0).Select
        Loop
        ts.WriteLine "  </domain>"
        ActiveCell.Offset(1, -1).Select
    Loop


    'Feature Datasets and Feature Classes
    Worksheets("FeatureClasses").Activate
    Range("A4").Select
    Do Until Selection = ""    'Loop through all feature datasets
        ts.WriteLine "  <featureDataset database="""" owner="""" table=""" & Selection & """>"
        ts.WriteLine "          <spatialReference minX=""-10000"" minY=""-10000"" precisionXY=""100000"" minM=""0"" precisionM=""100000"" minZ=""0"" precisionZ=""100000"" coordinateSystemDescription=""GEOGCS[&quot;GCS_North_American_1983&quot;,DATUM[&quot;D_North_American_1983&quot;,SPHEROID[&quot;GRS_1980&quot;,6378137.0,298.257222101]],PRIMEM[&quot;Greenwich&quot;,0.0],UNIT[&quot;Degree&quot;,0.0174532925199433]]""/>"
        ActiveCell.Offset(1, 1).Select
        Do Until Selection = ""    'Loop through all feature classes within a feature dataset
            stfield = ActiveCell.Offset(0, 6)
            stcode = ActiveCell.Offset(0, 7)
            ts.WriteLine "              <objectClass database="""" owner="""" table=""" & Selection & """ aliasName=""" & Selection & """ oidField=""OBJECTID"" esriDatasetType=""5"" esriFeatureType=""1"" shapeField=""SHAPE"" subtypeField=""" & stfield & """ defaultSubtypeCode=""" & stcode & """ modelName=""" & Selection & """ configKeyword="""">"
            ts.WriteLine "                      <field name=""OBJECTID"" aliasName=""OBJECTID"" esriFieldType=""6"" length=""4"" precision=""0"" required=""True"" scale=""0"" domainFixed=""False"" editable=""False"" isNullable=""False"" modelName=""OBJECTID""/>"
            ts.WriteLine "                      <field name=""Shape"" aliasName=""Shape"" esriFieldType=""7"" length=""0"" precision=""0"" required=""True"" scale=""0"" domainFixed=""False"" editable=""True"" isNullable=""True"" modelName=""Shape"">"
            ts.WriteLine "                              <geometryDef esriGeometryType=""" & ActiveCell.Offset(0, 2) & """ avgNumPoints=""0"" hasM=""" & ActiveCell.Offset(0, 4) & """ hasZ=""" & ActiveCell.Offset(0, 5) & """>"
            ts.WriteLine "                                      <grid size=""1000""/>"
            ts.WriteLine "                              </geometryDef>"
            ts.WriteLine "                      </field>"
            ActiveCell.Offset(3, 8).Select
            n = 0                       'initialize counter
            Do Until Selection = ""     'Loop through all fields within a feature class
                n = n + 1               'Count the number of fields
                ts.WriteLine "                  <field name=""" & Selection & """ aliasName=""" & Selection & """ esriFieldType=""" & ActiveCell.Offset(0, 1) & """ length=""" & ActiveCell.Offset(0, 3) & """ precision=""" & ActiveCell.Offset(0, 4) & """ required=""" & ActiveCell.Offset(0, 6) & """ scale=""" & ActiveCell.Offset(0, 5) & """ domainFixed=""False"" editable=""True"" isNullable=""True"" modelName=""" & Selection & """/>"
                ActiveCell.Offset(1, 0).Select
            Loop    'Loop fields
            ts.WriteLine "                      <subtype name="""" code="""">"
            ActiveCell.Offset(-n, 7).Select
            For i = 1 To n  'Loop through base domains
                If Selection <> "" Then ts.WriteLine "                          <field name=""" & ActiveCell.Offset(0, -7) & """ defaultValue="""" domain=""" & Selection & """/>"
                ActiveCell.Offset(1, 0).Select
            Next i  'Loop base domains
            ts.WriteLine "                      </subtype>"
            ActiveCell.Offset(0, 1).Select
            If stfield <> "" Then
                Do Until Selection = ""     'Loop through all subtype codes and names
                    ts.WriteLine "                      <subtype name=""" & ActiveCell.Offset(0, 1) & """ code=""" & Selection & """>"
                    ActiveCell.Offset(1, 2).Select
                    Do Until Selection = ""     'Loop through all subtype-specific domains
                        ts.WriteLine "                          <field name=""" & Selection & """ defaultValue="""" domain=""" & ActiveCell.Offset(0, 1) & """/>"
                        ActiveCell.Offset(1, 0).Select
                    Loop    'Loop subtype-specific domains
                    ts.WriteLine "                      </subtype>"
                    ActiveCell.Offset(0, -2).Select
                Loop    'Loop subtype codes and names
                ts.WriteLine "                  <index name=""subtype_INDEX"" isAscending=""True"" isUnique=""False"">"
                ts.WriteLine "                          <field name=""" & stfield & """/>"
                ts.WriteLine "                  </index>"
            End If
            ts.WriteLine "                      <index name=""FDO_OBJECTID"" isAscending=""True"" isUnique=""True"">"
            ts.WriteLine "                              <field name=""OBJECTID""/>"
            ts.WriteLine "                      </index>"
            ts.WriteLine "                      <index name=""Shape_INDEX"" isAscending=""True"" isUnique=""False"">"
            ts.WriteLine "                              <field name=""Shape""/>"
            ts.WriteLine "                      </index>"
            ts.WriteLine "              </objectClass>"
            ActiveCell.Offset(1, -16).Select
        Loop    'Loop feature classes
    ActiveCell.Offset(0, -1).Select
    ts.WriteLine "      </featureDataset>"
    Loop   'Loop feature datasets


    'Object Classes
    Worksheets("ObjectClasses").Activate
    Range("A4").Select
    Do Until Selection = ""     'Loop through all object classes
        stfield = ActiveCell.Offset(0, 2)
        stcode = ActiveCell.Offset(0, 3)
        ts.WriteLine "  <objectClass database="""" owner="""" table=""" & Selection & """ aliasName=""" & Selection & """ oidField=""OBJECTID"" esriDatasetType=""10"" esriFeatureType="""" shapeField="""" subtypeField=""" & stfield & """ defaultSubtypeCode=""" & stcode & """ modelName=""" & Selection & """ configKeyword="""">"
        ts.WriteLine "          <field name=""OBJECTID"" aliasName=""OBJECTID"" esriFieldType=""6"" length=""4"" precision=""0"" required=""True"" scale=""0"" domainFixed=""False"" editable=""False"" isNullable=""False"" modelName=""OBJECTID""/>"
        ActiveCell.Offset(2, 4).Select
        n = 0                       'initialize counter
        Do Until Selection = ""     'Loop through all fields within a feature class
            n = n + 1               'Count the number of fields
            ts.WriteLine "              <field name=""" & Selection & """ aliasName=""" & Selection & """ esriFieldType=""" & ActiveCell.Offset(0, 1) & """ length=""" & ActiveCell.Offset(0, 3) & """ precision=""" & ActiveCell.Offset(0, 4) & """ required=""" & ActiveCell.Offset(0, 6) & """ scale=""" & ActiveCell.Offset(0, 5) & """ domainFixed=""False"" editable=""True"" isNullable=""True"" modelName=""" & Selection & """/>"
            ActiveCell.Offset(1, 0).Select
        Loop    'Loop fields
        ts.WriteLine "          <subtype name="""" code="""">"
        ActiveCell.Offset(-n, 7).Select
        For i = 1 To n  'Loop through base domains
            If Selection <> "" Then ts.WriteLine "                      <field name=""" & ActiveCell.Offset(0, -7) & """ defaultValue="""" domain=""" & Selection & """/>"
            ActiveCell.Offset(1, 0).Select
        Next i  'Loop base domains
        ts.WriteLine "          </subtype>"
        ActiveCell.Offset(0, 1).Select
        If stfield <> "" Then
            Do Until Selection = ""     'Loop through all subtype codes and names
                ts.WriteLine "          <subtype name=""" & ActiveCell.Offset(0, 1) & """ code=""" & Selection & """>"
                ActiveCell.Offset(1, 2).Select
                Do Until Selection = ""     'Loop through all subtype-specific domains
                    ts.WriteLine "                      <field name=""" & Selection & """ defaultValue="""" domain=""" & ActiveCell.Offset(0, 1) & """/>"
                    ActiveCell.Offset(1, 0).Select
                Loop    'Loop subtype-specific domains
                ts.WriteLine "          </subtype>"
                ActiveCell.Offset(0, -2).Select
            Loop    'Loop subtype codes and names
            ts.WriteLine "              <index name=""subtype_INDEX"" isAscending=""True"" isUnique=""False"">"
            ts.WriteLine "                      <field name=""" & stfield & """/>"
            ts.WriteLine "              </index>"
        End If
        ts.WriteLine "          <index name=""FDO_OBJECTID"" isAscending=""True"" isUnique=""True"">"
        ts.WriteLine "                  <field name=""OBJECTID""/>"
        ts.WriteLine "          </index>"
        ts.WriteLine "          <index name=""Shape_INDEX"" isAscending=""True"" isUnique=""False"">"
        ts.WriteLine "                  <field name=""Shape""/>"
        ts.WriteLine "          </index>"
        ts.WriteLine "  </objectClass>"
        ActiveCell.Offset(1, -12).Select
    Loop    'Loop object classes


    'Relationships
    Worksheets("Relationships").Activate
    Range("A4").Select
    Do Until Selection = ""     'Loop through all relationships
        ts.WriteLine "  <relationshipClass database="""" owner="""" table=""" & Selection & """ esriRelCardinality=""" & ActiveCell.Offset(0, 5) & """ esriRelNotification=""1"" isComposite=""False"" isAttributed=""False"" originPrimaryKey=""" & ActiveCell.Offset(0, 2) & """ originForeignKey=""" & ActiveCell.Offset(0, 4) & """ destinationPrimaryKey="""" destinationForeignKey="""">"
        ts.WriteLine "          <featureDataset database="""" owner="""" table=""""/>"
        ts.WriteLine "          <origin database="""" owner="""" table=""" & ActiveCell.Offset(0, 1) & """ label=""" & ActiveCell.Offset(0, 1) & """/>"
        ts.WriteLine "          <destination database="""" owner="""" table=""" & ActiveCell.Offset(0, 3) & """ label=""" & ActiveCell.Offset(0, 3) & """/>"
        ts.WriteLine "  </relationshipClass>"
        ActiveCell.Offset(1, 0).Select
    Loop    'Loop relationships


    'Finish writing XML and close the XML file
    ts.Write "</geodatabaseDesigner>"
    ts.Close
    Set ts = Nothing
    Set fso = Nothing
    
9999    If filename = "" Then
            message = "USER CANCELLED"
        Else
            message = "XML Complete"
        End If

MsgBox (message)

End Sub