Bo2SS

Sub 循环遍历文件夹()
'
' 循环遍历文件夹 宏
'
'
    On Error Resume Next '当宏内出现"运行时错误"时，程序会继续运行，不中断

    'Dim声明变量，As后指定类型，如果不指定，默认为Variant类型
    '$是As String的简写，&是As Long的缩写
    Dim objShell As Object, objFolder As Object, pPath$, f As Object, fd As Object, fso As Object, Stack$(), top&, n&, stxt$, doc As Document, x&
    
    'Set用来分配对象引用，也就是设值
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, "请选择要进行批量处理的文件夹！", 0, 0)
    If (objFolder Is Nothing) Then Exit Sub  '如果选择了Cancel，则直接退出
    
    '获取文件夹路径
    pPath = objFolder.self.Path & ""

    Set objShell = Nothing
    Set objFolder = Nothing

    Set fso = CreateObject("Scripting.FileSystemObject")

    top = 1
    ReDim Stack(0 To top)

    '遍历文件夹，包括子文件夹（利用栈结构记录）
    Do While top >= 1
        For Each f In fso.GetFolder(pPath).Files
            n = n + 1
            stxt = f.Path
            '处理.doc和.docs文件
                If stxt Like "*.doc*" Then
                Set doc = Documents.Open(FileName:=stxt, Visible:=True)  'Visible设为True，有的操作需要可见才生效
                Call 文本替换  '【单个文档的处理方式】请选择任意宏使用！
                doc.Close SaveChanges:=wdSaveChanges  ':=用于给参数赋值
                x = x + 1
            End If
        Next
        For Each fd In fso.GetFolder(pPath).SubFolders
            Stack(top) = fd.Path
            top = top + 1
            If top > UBound(Stack) Then ReDim Preserve Stack(0 To top)
        Next
        If top > 0 Then pPath = Stack(top - 1): top = top - 1  '":"用于连接两个语句
    Loop

    Set f = Nothing
    Set fd = Nothing
    Set fso = Nothing

    '若不使用函数的返回值，则不需要括号，否则需要将参数包含在括号中
    MsgBox "文件夹包含 " & n & " 个文件！" & vbCr & "共处理 Word 文档(*.docx/*.doc) " & x & " 个！", 0 + 48
    
End Sub

Sub 文本替换()
'
' 文本替换 宏
'
'
    With ActiveDocument.Content.Find
        .ClearFormatting
        With .Replacement
            .ClearFormatting
            .Font.Bold = True  '字体加粗
            .Font.Underline = wdUnderlineSingle  '添加单下划线
        End With
    
        '执行查找并替换：'FindText是要查找的文本，ReplaceWith是替换后的文本，Format为True表示带格式
        '"_"用来分行
        .Execute _
            FindText:="公众号", _
            ReplaceWith:="Bo2SS", _
            Format:=True, _
            Replace:=wdReplaceAll  'wdReplaceAll替换所有，wdReplaceOne只替换一次
    End With
    
End Sub

Sub 删除最后一页()
'
' 删除最后一页 宏
'
'
    Dim pageNum As Long, StartPage As Long, EndPage As Long
    
    '获取总页数
    pageNum = Word.ActiveDocument.Range.Information(wdNumberOfPagesInDocument)
    
    '确定最后一页的起始范围，并选中
    StartPage = Selection.GoTo(What:=wdGoToPage, Which:=wdGoToNext, Count:=pageNum - 1).Start
    EndPage = ActiveDocument.Content.End
    ActiveDocument.Range(StartPage, EndPage).Select
    
    '删除选中内容
    Selection.Delete
    
End Sub

Sub 文末添加内容()
'
' 文末添加内容 宏
'
'
   Dim oRng As Range, oDoc As Document
   
   Set oDoc = Word.ActiveDocument
   Set oRng = oDoc.Content
   
   With oRng
        '在文档的末尾插入字符，如Chr(10)则添加换行、"你好"则添加你好
        .InsertAfter Chr(10)
        '.InsertAfter "你好"
   End With
End Sub