遍历文件夹下所有word，执行固定的宏

努牛 · 发表于 2017-3-8 14:10

求教各位大神，有没有一个可以让某一文件夹（含多级子文件夹的文件夹）下所有word文档都执行某一固定宏的宏呢？
比如，我想使附件文件夹中多个word的字体全部变黑。
字体变黑的宏，我已录好：
Sub 字体变黑()
'
' 字体变黑宏
'
'
Selection.WholeStory
Selection.Font.Color = wdColorAutomatic
ActiveDocument.Save
Application.Run MacroName:="MathTypeCommands.UIEnableDisable.UIUpdate"
End Sub

duquancai · 发表于 2017-3-8 16:20

有遍历指定文件夹下的文件以及其所有子文件夹下的所有文件。但是你录制的宏差劲啊！

努牛 · 发表于 2017-3-8 16:49

duquancai 发表于 2017-3-8 16:20
有遍历指定文件夹下的文件以及其所有子文件夹下的所有文件。但是你录制的宏差劲啊！

抱歉了大侠。还请指导，如何引用一个宏，让其遍历执行指定文件夹下的文件以及其所有子文件夹下的所有文件。

duquancai · 发表于 2017-3-8 17:45

抱歉了，没时间

jiminyanyan · 发表于 2017-3-8 22:38

http://club.excelhome.net/thread-1122501-1-1.html
楼主可先研究一下我这个帖子。

jiminyanyan · 发表于 2017-3-9 19:04

提供下思路，这样写代码感觉没什么问题，但是测试不对…………

duquancai · 发表于 2017-3-9 19:36

jiminyanyan 发表于 2017-3-9 19:04
提供下思路，这样写代码感觉没什么问题，但是测试不对…………

这题很简单啊！就是遍历指定文件夹下的文件以及其所有子文件夹下的所有文件，剩下的事情很简单嘛！

jiminyanyan · 发表于 2017-3-9 20:26

借用ＤＵ老师的代码，写一个……。

Sub 遍历所有文件夹中的文件()
Dim arr(1 To 100000) As String, i&, k&, x&, f$, f1$, oDoc As Document
Dim Osec As Section, Ohefo As HeaderFooter
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
arr(1) = .SelectedItems(1) & ""
End With
i = 1: k = 1
Do While i < UBound(arr)
If arr(i) = "" Then Exit Do
f = Dir(arr(i), vbDirectory)
Do
If InStr(f, ".") = 0 And f <> "" Then
k = k + 1
arr(k) = arr(i) & f & ""
End If
f = Dir
Loop Until f = ""
i = i + 1
Loop
For x = 1 To UBound(arr)
If arr(x) = "" Then Exit For
f1 = Dir(arr(x) & "*.doc*")
Do While f1 <> ""
Set oDoc = Documents.Open(arr(x) & f1, Visible:=True)
Selection.WholeStory
Selection.Font.Color = wdColorBlack
oDoc.Close True
Set oDoc = Nothing
f1 = Dir
Loop
Next x
Application.ScreenUpdating = True
End Sub

复制代码

jiminyanyan · 发表于 2017-3-9 20:29

……。。…。…。………

duquancai · 发表于 2017-3-9 21:09

附件，打开文档，点击按钮》》》》》》》》

		自动登录	找回密码
密码			免费注册

[求助] 遍历文件夹下所有word，执行固定的宏

评分

评分