批量更新多个word中的所有域——解决邮件合并图片不能自动更新的问题

xipick

最近，手头上有一工作需要用到邮件合并功能，并且还要插入图片，插入图片用的是域includepicture加邮件合并的合并域来实现的，因为我需要每行数据保存为一个文件，而用word2007只能保存为一个文件，这不符合我想要的效果，好像word２００３可以实现保存为不同的文件，但是我没有装２００３word，所以只好用了wps，只是保存的时候选择的是doc文件。这样是能够把所有的图片的地址正确的弄进去，可是就是无法实现显示正确的图片，每个文档都显示的是主文档中显示的那张图片，并且在wps下，不管怎么按F9,或是ＳＨＩＦＴ+Ｆ９都没有用，只有在word下打开，然后ＣＴＲＬ+Ａ全选后，再按Ｆ９，才能显示出正确的图片，这很让人恼火，本来邮件合并就是为了省事，不想一个一个的打开文档处理。后来，就想能不能批量实现在word下把所有文件都进行更新域呢。记得以前拼凑过一个批量处理word文档的宏，又在网上搜到了更新域的宏，于是就凑合了一下，生成了下面这个宏。该宏能够实现对于邮件合并后，不能正确显示相应图片的文档进行处理。宏的内容如下，但是如果用的话，需要下载下面的这个文档

1. Sub 批量更新多个word中的所有域()
   
2. 
   
3. 
   
4. 
   
5. '以下是重复执行代码,也就是选择所有需要进行更新域的word文档
   
6. 
   
7. Dim MyDialog As FileDialog, GetStr(1 To 1000) As String    '1000是工作时最多的文档数,可以修改
   
8. On Error Resume Next
   
9. Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
   
10. With MyDialog
    
11.     .Filters.Clear
    
12.     .Filters.Add "所有WORD文件", "*.doc", 1
    
13.     .AllowMultiSelect = True '允许多项选择
    
14.     i = 1
    
15.     If .Show = -1 Then
    
16.         For Each stiSelectedItem In .SelectedItems
    
17.             GetStr(i) = stiSelectedItem
    
18.             i = i + 1
    
19.         Next
    
20.         i = i - 1
    
21.     End If
    
22.    
    
23.     Application.ScreenUpdating = False
    
24.     For j = 1 To i Step 1
    
25.         Set Doc = Documents.Open(FileName:=GetStr(j), Visible:=True)
    
26.         Windows(GetStr(j)).Activate
    
27. 
    
28.         
    
29.    '以下是在单个文件中运行的宏，也就是对一个文档进行更新域
    
30.         
    
31.    
    
32. Dim b As Field
    
33.     For Each b In ActiveDocument.Fields
    
34.         b.Update
    
35.     Next
    
36. 
    
37.    
    
38.     '以上是在单个文件中运行的宏
    
39.    
    
40. Selection.Find.Execute Replace:=wdReplaceAll
    
41. 
    
42. Application.Run macroname:="NEWMACROS"
    
43.         ActiveDocument.Save
    
44.         ActiveWindow.Close
    
45.     Next
    
46.     Application.ScreenUpdating = True
    
47. End With
    
48.     MsgBox "修改完毕!请查看！！", vbInformation
    
49.     End Sub
    
50. 
    
51. 
    
52. 
    

复制代码

最后说明一下，这个文档只能处理后缀名是doc的文件，也就是说邮件合并后得到的文件是word文档才行，测试用在wps上面没有用

ljqn73

用上了，顶一个

wsk888

好的，正好用得上？

kuku163

Sub 宏1()
'
' 更新所有图片
'
'
For Each shp In ActiveDocument.Shapes
    shp.Select
    Selection.Fields.Update
Next
End Sub

wtzjcg

试下看看，感谢

wtzjcg

用了一下，唯一的弊端是最后一个文件的还需要收到更新不知道是什么情况，就是比如10个文档，执行完毕会把最后一个文档打开展示给你，你会发现就是这个的图片没有更新，好奇怪，就是这个需要手动再更新下，不过已经很好了

momo6235290

学习一下，正好可用