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

时间 2019-11-10

标签 word 文档 vba 读写 properties 文件起来栏目 Microsoft Office 繁體版

原文原文链接

一、问题背景

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

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

二、分析解决

首先有一个域（Field），引发了个人关注测试

它就是Document Automation下的DocVariable。优化

若是能够定义这个值和修改（name=value），从某种意义上讲word也能够像程序同样定义变量了。ui

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

三、VBA程序代码

首先按Alt+F11呼出VBA控制台，选择你Word文档的ThisDocument，粘贴如下代码code

'配置文件名默认为 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配置后，你就能够批量替换文档内容）。orm

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，其它环境没有试验过。