Word文檔VBA讀寫Properties文件，讓文檔動起來

一、問題背景

因爲最近寫Word文檔比較多，發現文檔中不少內容有重複。固然經常使用手法就是Ctrl+V、Ctrl+C，開始可能還行。但隨後客戶提出修改要求時就瘋了。

Word中爲啥沒有個變量？
我開始只知道Word有域的概念，但在界面上操做時遇到了困難，很難定義。

二、分析解決

首先有一個域（Field），引發了個人關注

它就是Document Automation下的DocVariable。

若是能夠定義這個值和修改（name=value），從某種意義上講word也能夠像程序同樣定義變量了。

但問題來了，若是想改變這個值必須經過VBA開發來完成。（-_-寫VB吧）

三、VBA程序代碼

首先按Alt+F11呼出VBA控制檯，選擇你Word文檔的ThisDocument，粘貼如下代碼

'配置文件名默認爲 word文件名-docvar.txt
'配置文件格式 key=value，#爲註釋

'解除DovVariable Field，轉換爲普通文字
Sub unlinkDocVarFields()

Dim varResponse As Variant

varResponse = MsgBox("是否把文檔中的DocumentVariable域替換爲普通文字？", vbYesNo)

    If varResponse = vbYes Then

        Dim bTrack As Boolean
        bTrack = ActiveDocument.TrackRevisions
        ActiveDocument.TrackRevisions = False


        '遍歷DocVariable域
        Dim fCount As Integer
        fCount = 0
        For Each oFld In ActiveDocument.Fields
            If oFld.Type = wdFieldDocVariable Then
                '撤消域鏈接
                oFld.Unlink
                '無效會被替換 Error! No document variable supplied.
                fCount = fCount + 1
            End If
        Next oFld
        
        ActiveDocument.TrackRevisions = bTrack
        MsgBox "完成對" & fCount & "個DocVar域替換！"
        
    End If

End Sub

'讀取txt文件中的DovVariable配置
Sub loadDocVarsFile()

Dim varResponse As Variant

varResponse = MsgBox("是否讀取載入DocVar文件中的配置，並更新全部DocVar域？", vbYesNo)

    If varResponse = vbYes Then

        Dim bTrack As Boolean
        bTrack = ActiveDocument.TrackRevisions
        ActiveDocument.TrackRevisions = False

        Dim sFileName As String
        Dim iFileNum As Integer
        Dim sBuf As String
        Dim iPos As Integer
        Dim sName As String
        Dim sValue As String
    
        sFileName = ActiveDocument.FullName & "-docvar.txt"
    
        If Len(Dir$(sFileName)) = 0 Then
            MsgBox "沒有找到" & sFileName
            Exit Sub
        End If
    
        '讀取文件
        iFileNum = FreeFile()
        Dim vCount As Integer
        vCount = 0
        Open sFileName For Input As iFileNum
    
        Do While Not EOF(iFileNum)
            Line Input #iFileNum, sBuf
    
            If InStr(1, Trim(sBuf), "#") <> 1 Then '#開頭的配置認爲是註釋
                
                iPos = InStr(1, sBuf, "=") '拆分等號
                If iPos <> 0 Then
                  sName = Trim(Left(sBuf, iPos - 1)) 'key
                  sValue = Trim(Mid(sBuf, iPos + 1, Len(sBuf) - iPos)) 'value
                
                  If Len(sName) <> 0 Then
                     ActiveDocument.Variables(sName).Value = sValue '更新文檔的Variables
                     vCount = vCount + 1
                  End If
                End If
                
            End If
    
        Loop
    
        Close iFileNum
    
        '更新所有wdFieldDocVariable域
        Dim fCount As Integer
        fCount = updateAllDocVarField()
        
        ActiveDocument.TrackRevisions = bTrack
        MsgBox "完成讀取載入" & vCount & "個DocVar配置信息，並更新" & fCount & "個域！"
    
    End If

End Sub

'把光標位置所作的域修改的值更新到其它同名域
Sub updateSelectDocVar()

    If Selection.Fields.Count <> 0 Then
        Dim varResponse As Variant
        varResponse = MsgBox("是否把此域的內容更新到其它同名域？", vbYesNo)
        If varResponse = vbYes Then
        
            Dim bTrack As Boolean
            bTrack = ActiveDocument.TrackRevisions
            ActiveDocument.TrackRevisions = False
        
            Dim ofi As Variant
            Dim fname As String
            Dim fvalue As String
            
            If Selection.Fields(1).Type = wdFieldDocVariable Then
            
                fname = getFieldName(Selection.Fields(1))
                fvalue = getFieldValue(Selection.Fields(1))
                ActiveDocument.Variables(fname).Value = fvalue
                
                '更新所有wdFieldDocVariable域
                Dim fCount As Integer
                fCount = updateAllDocVarField()
            Else
                MsgBox "域不是DocVariable類型"
            End If
            
            ActiveDocument.TrackRevisions = bTrack
            MsgBox "完成其它[" & fname & "=" & fvalue & "]" & fCount & "個域值的更新！"
            
        End If
    Else
        MsgBox "請選擇須要更新的域！"
    End If
    

End Sub

'把word中的DocVarField內容寫入txt文本
Sub saveDocVarsFile()

    Dim bTrack As Boolean
    bTrack = ActiveDocument.TrackRevisions
    ActiveDocument.TrackRevisions = False

    Dim sFileName As String
    Dim sFileNameBackup As String
    Dim iFileNum As Integer
    Dim sCode As String
    Dim sPos As Integer
    
    sFileName = ActiveDocument.FullName & "-docvar.txt" '老文件名
    sFileNameBackup = ActiveDocument.FullName & "-docvar-" & Format(Now(), "yyyyMMddhhmmss") & ".txt" '備份文件名

    '備份原有docvar文件
    If Len(Dir$(sFileName)) <> 0 Then
      Name sFileName As sFileNameBackup
    End If
    
    '域修改值更新回DocumentVariables
    Dim docKey As String
    Dim docName As String
    Dim docValue As String
    Dim docOldValue As String
    Dim changeList As Collection
    Set changeList = New Collection
    Dim changeListCount As Integer
    
    docKey = "DOCVARIABLE"
    changeListCount = 0
    
    For Each oFld In ActiveDocument.Fields
        If oFld.Type = wdFieldDocVariable Then
            '從域code中提取DocVar的名字
            
            If Len(oFld) = 0 Then '刪除無效field
                oFld.Delete
            Else
                docName = getFieldName(oFld)
                docValue = getFieldValue(oFld)
                
                '判斷域中定義的DocVar是否存在Variables中
                On Error Resume Next
                docOldValue = ActiveDocument.Variables(docName).Value
                If Err.Number = 0 Then '存在
                    If docValue <> docOldValue Then '文檔中域值與Variables中的值不相同時，說明文檔中有修改
                    
                       changeList.Add ("# 第" & oFld.Code.Information(wdActiveEndPageNumber) & "頁 第" & oFld.Code.Information(wdFirstCharacterLineNumber) & "行 # " & docName & "=" & docValue)
                       changeListCount = changeListCount + 1
                    End If
                Else '不存在，直接寫入
                    ActiveDocument.Variables(docName) = docValue
                End If
                On Error GoTo 0
            End If
        End If

    Next oFld
    
    '寫文件
    iFileNum = FreeFile()
    
    Dim vCount As Integer
    vCount = 0
    Open sFileName For Output As iFileNum

        Print #iFileNum, "# 保存時間："; Format(Now(), "yyyy年MM月dd日 hh:mm:ss")
        Print #iFileNum, ""
        For Each oVar In ActiveDocument.Variables
            
            Dim outline As String
            outline = oVar.Name & "=" & oVar.Value
            Print #iFileNum, outline
            vCount = vCount + 1
        Next oVar
        
        Print #iFileNum, ""
        Print #iFileNum, "# 文檔中的域值變動記錄(值衝突)"
        Print #iFileNum, ""
        
        For Each iChange In changeList
            Print #iFileNum, iChange
        Next
        
    Close iFileNum
    
    ActiveDocument.TrackRevisions = bTrack
    MsgBox "完成對DocVar配置信息的寫入，供寫入" & vCount & "個DocVar，" & changeListCount & "個值衝突域！"
    Shell "Notepad.exe " & sFileName, vbNormalFocus
    
End Sub

'更新所有wdFieldDocVariable域，無變化不更新
Private Function updateAllDocVarField() As Integer
        
        Dim fCount As Integer
        fCount = 0
        For Each oFld In ActiveDocument.Fields
            If oFld.Type = wdFieldDocVariable Then
                If ActiveDocument.Variables(getFieldName(oFld)).Value <> getFieldValue(oFld) Then
                    oFld.Update
                    fCount = fCount + 1
                End If
            End If
        Next oFld
        updateAllDocVarField = fCount
End Function

'獲取DovVariable Field的name
Private Function getFieldName(oFld As Variant) As String
    Dim docKey As String
    docKey = "DOCVARIABLE"
    getFieldName = Trim(Mid(oFld.Code, (InStr(1, oFld.Code, docKey) + Len(docKey) + 1), InStr(1, oFld.Code, "\*") - InStr(1, oFld.Code, docKey) - Len(docKey) - 1))
End Function

'獲取DovVariable Field的Result（顯示結果）
Private Function getFieldValue(oFld As Variant) As String
    getFieldValue = Trim(oFld.Result)
End Function

saveDocVarsFile是來保存你在文檔中定義的DocVariable（爲啥保存，爲了之後批量程序修改）。
會保存爲一個xxx-docvar.txt文件，裏面就是你Word中配置的全部DocVariable。
這個會自動生成docvar-yyyyMMddhhmmss.txt備份。因此不用擔憂內容丟失。

loadDocVarsFile是來讀取配置，並更新全部DocVariable域（修改完txt配置後，你就能夠批量替換文檔內容）。

unlinkDocVarFields是用來轉換DocVariable域爲普通文本用的（最後的交付，注意必定是最後，不但願採用DocVariable域方式。手工方式是選中Word聽DocVariable區域按Ctrl+Alt+F9）

updateSelectDocVar是用來把選擇域中修改的內容當即更新其它同名域的方法

四、VBA運用過程

a、編寫初始配置文件

運行saveDocVarsFile就會自動打開一個xxx-docvar.txt的文件（#爲註釋）
加入如下內容並保存txt（格式：name=value）

測試=測試文字段落

b、從新載入配置運行

運行loadDocVarsFile

c、在文檔中加入一個叫測試的DocVariable

Insert->Quick Parts->Field->DocVariable，name輸入剛纔寫的'測試'

這時你會發現，內容顯示爲「測試文字段落」。（注意b,c順序，若是先作c可能顯示空白，由於尚未值）

d、文檔中複製這個區域

複製提供多個位置使用

*e、修改Word中一個域的值，反更新配置文件

在一個Word文字中加入abc。再執行saveDocVarsFile。文本的內容會變爲

# 保存時間：2012年09月20日 13:19:42

測試=測試文字段落

# 文檔中的域值變動記錄(值衝突)

# 第1頁 第2行 # 測試=測試文字abc段落

saveDocVarsFile會自動發現變化的域所在的頁號與行號。

*f、批量更新

把 測試=測試文字段落 替換爲 測試=測試文字abc段落，保存（意思是你接受了這個值對全局的修改）

# 保存時間：2012年09月20日 13:19:42

測試=測試文字abc段落

# 文檔中的域值變動記錄(值衝突)

# 第1頁 第2行 # 測試=測試文字abc段落

再執行loadDocVarsFile

文檔中的DocVariable('測試')顯示的位置都會改變。

五、結束語

DocVariable域能夠支持複製到其它文檔。若是再用這個宏時注意要先save再load。若是直接load將致使內容丟失。

程序對我來講屬於夠用範圍，固然還有能夠優化的地方你們能夠本身再改改。（如：能夠寫一個加入DocVariable的宏，就能夠不用先load）

個人環境是XP，Word 2010，其它環境沒有試驗過。