Sub ExportCustom()‘‘ ExportCustom 宏‘ 导出自定义属性到custom.txt‘    Dim lFileNumber As Long    Dim sFilePath As String    Dim current As Object    Set current = ActiveDocument    sFilePath = current.Path + "\Custom.txt"    lFileNumber = FreeFile()    Open sFilePath For Output As #lFileNumber    Dim i As Integer    For Each objProp In current.CustomDocumentProperties        Dim bRegular As Boolean        bRegular = True        If objProp.Name = "ProprietaryDeclaration" Then            bRegular = False        End If        If objProp.Name = "slevel" Then            bRegular = False        End If        If objProp.Name = "slevelui" Then            bRegular = False        End If        If objProp.Name = "sflag" Then            bRegular = False        End If        If bRegular Then            Print #lFileNumber, objProp.Name & vbTab & objProp.Value        End If    Next        Close #lFileNumber    MsgBox "导出完毕！"End SubSub UpdateCustom()‘‘ UpdateCustom 宏‘‘    Dim strUpdateContent As String    Dim strNotFoundProperty  As String        Dim current As Object    Set current = ActiveDocument    Dim lFileNumber As Long    lFileNumber = FreeFile()    Open current.Path + "\Custom.txt" For Input As #lFileNumber ‘ 打开文件。    Dim TextLine As String    Dim tmpObj As Object    Dim iTabIndex As Integer    Do While Not EOF(lFileNumber) ‘ 循环至文件尾。        Line Input #lFileNumber, TextLine ‘ 读入一行数据并将其赋予某变量。                If Not (TextLine = "") Then                            iTabIndex = InStr(TextLine, vbTab)            If Not (iTabIndex = 0 Or iTabIndex = 1 Or iTabIndex = Len(TextLine)) Then                                Dim strName As String                Dim strValue As String                                strName = Mid(TextLine, 1, iTabIndex - 1)                Debug.Print strName ‘ 在调试窗口中显示数据。                strValue = http://www.mamicode.com/Mid(TextLine, iTabIndex + 1)                Debug.Print strValue ‘ 在调试窗口中显示数据。                                On Error Resume Next                Set tmpObj = Nothing                Set tmpObj = current.CustomDocumentProperties(strName)                On Error GoTo 0                If Not (tmpObj Is Nothing) Then                    If (tmpObj.Type = msoPropertyTypeString And (Not (tmpObj.Value = http://www.mamicode.com/strValue))) Then                        strUpdateContent = strUpdateContent & vbCrLf & tmpObj.Name & vbTab & tmpObj.Value & "==>>" & strValue                        tmpObj.Value = strValue                    End If                Else                    strNotFoundProperty = strNotFoundProperty & vbCrLf & strName                End If            End If                End If            Loop    Dim strMsg As String    If Not (strUpdateContent = "") Then        strMsg = strMsg & "Update content:" & strUpdateContent    End If        If Not (strNotFoundProperty = "") Then        strMsg = strMsg & "Not found property:" & strNotFoundProperty    End If        If (strMsg = "") Then        strMsg = "No Update"    End If        MsgBox strMsgEnd SubSub SortCustom()‘‘ SortCustom 宏‘‘    Dim current As Object    Set current = ActiveDocument    sFilePath = current.Path + "\Custom.txt"    Dim propertys() As Object    ‘Set propertys = current.CustomDocumentProperties    Dim iPropLen As Integer    iPropLen = current.CustomDocumentProperties.Count    Dim i As Integer    Dim iTmpPropLen As Integer    iTmpPropLen = iPropLen    Dim bFlag As Boolean    bFlag = True    Do While bFlag And iTmpPropLen > 1        bFlag = False        For i = 1 To (iTmpPropLen - 1)            If current.CustomDocumentProperties(i).Name > current.CustomDocumentProperties(i + 1).Name Then                bFlag = True                                Dim tmpProp1 As Object                Set tmpProp1 = current.CustomDocumentProperties(i)                Dim tmpProp2 As Object                Set tmpProp2 = current.CustomDocumentProperties(i + 1)                                Dim tmpPropName As String                Dim tmpPropType As Integer                Dim tmpPropLinkToContent As Boolean                Dim tmpPropValue As String                tmpPropName = tmpProp1.Name                tmpPropType = tmpProp1.Type                tmpPropLinkToContent = tmpProp1.LinkToContent                tmpPropValue = tmpProp1.Value                tmpProp1.Name = "tmp"                tmpProp1.Type = msoPropertyTypeString                tmpProp1.LinkToContent = False                tmpProp1.Value = "tmp"                                Dim tmpPropName2 As String                Dim tmpPropType2 As Integer                Dim tmpPropLinkToContent2 As Boolean                Dim tmpPropValue2 As String                tmpPropName2 = tmpProp2.Name                tmpPropType2 = tmpProp2.Type                tmpPropLinkToContent2 = tmpProp2.LinkToContent                tmpPropValue2 = tmpProp2.Value                tmpProp2.Name = tmpPropName                tmpProp2.Type = tmpPropType                tmpProp2.LinkToContent = tmpPropLinkToContent                tmpProp2.Value = tmpPropValue                                tmpProp1.Name = tmpPropName2                tmpProp1.Type = tmpPropType2                tmpProp1.LinkToContent = tmpPropLinkToContent2                tmpProp1.Value = tmpPropValue2            End If        Next        iTmpPropLen = iTmpPropLen - 1    Loop            MsgBox "排序完毕！"End Sub