Word文档VBA读写Properties文件，让文档动起来

时　间:2016-04-15 08:26:30
作　者:缪炜   ID：24010  城市：江阴
摘　要:Word文档VBA读写Properties文件，让文档动起来
正　文:

1、问题背景

由于最近写Word文档比较多，发现文档中很多内容有重复。当然常用手法就是Ctrl+V、Ctrl+C，开始可能还行。但随后客户提出修改要求时就疯了。

Word中为啥没有个变量？
我开始只知道Word有域的概念，但在界面上操作时遇到了困难，很难定义。

2、分析解决

首先有一个域（Field），引起了我的关注

它就是Document Automation下的DocVariable。

如果可以定义这个值和修改（name=value），从某种意义上讲word也可以像程序一样定义变量了。

但问题来了，如果想改变这个值必须通过VBA开发来完成。（-_-写VB吧）

3、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是用来把选择域中修改的内容立即更新其它同名域的方法

4、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

saveDocVarsFile会自动发现变化的域所在的页号与行号。

*f、批量更新

把 测试=测试文字段落 替换为 测试=测试文字abc段落，保存（意思是你接受了这个值对全局的修改）

 

再执行loadDocVarsFile

文档中的DocVariable('测试')显示的位置都会改变。

5、结束语

DocVariable域可以支持复制到其它文档。如果再用这个宏时注意要先save再load。如果直接load将导致内容丢失。

程序对我来说属于够用范围，当然还有可以优化的地方大家可以自己再改改。（如：可以写一个加入DocVariable的宏，就可以不用先load）

我的环境是XP，Word 2010，其它环境没有试验过。

 

 

Access软件网官方交流QQ群 (群号:54525238) 　　　　　　Access源码网店