如何使用VBA对word、excel、ppt的首页首行左侧批量添加文字

对于一份简单的Word文档，基本的查找VBA可以像下面这样实现：

Dim hasFound ' 定义是否找到

Selection.WholeStory

With Selection.Find

.ClearFormatting

.MatchWholeWord = False

.MatchCase = False

hasFound = .Execute("要查找的文字")

End With

转化为VBScript代码也很容易，多个创建Word.Application并打开Word文件的过程。

下面定义FileFinder接口，当然VBS没有接口的概念，我们只是象征式的说明下：

Interface FileFinder

Function isTextExists(search, filename)

End Function

End Interface

只需要实现一个方法接口，那就是isTextExists，判断要搜索的文本是否存在于指定的文件中。下面给出关于Word查找的VBS脚本代码实现：

Class DocumentsFinder

Private vbaObject

Private Application

Private Sub Class_Initialize()

Set vbaObject = WSH.CreateObject("Word.Application")

vbaObject.Visible = False

End Sub

Private Sub Class_Terminate()

vbaObject.Visible = True

vbaObject.Quit

Set vbaObject = Nothing

End Sub

Private Function SearchStringInSingleDocument(str, doc)

Dim Selection

Set Selection = vbaObject.Selection

Selection.WholeStory

With Selection.Find

.ClearFormatting

.MatchWholeWord = False

.MatchCase = False

SearchStringInSingleDocument =.Execute(str)

End With

Set Selection = Nothing

End Function

Public Function isTextExists(str, filename)

On Error Resume Next

Dim doc

Set doc = vbaObject.Documents.Open(filename)

isTextExists = SearchStringInSingleDocument(str, doc)

doc.Close

Set doc = Nothing

If Err Then Err.Clear

End Function

End Class

其中调用了Documents.Open打开一个Word文档，然后再通过SearchStringInSingleDocument方法来搜索指定文档的文字，这个方法就是刚才讲解的VBA宏的实现。

Option Explicit

Sub a()

   ' On Error Resume Next

    Dim sFolderFullPath As String

    Dim oFiles As Collection

    Dim lFileIndex As Long

    Dim sFileFullName As String, sFileName As String

    Dim oDoc As Word.Document

    Dim lDocCount As Long

    

    Const addText = "text" & vbCrLf & "此份文档能够解析大型的DBX文件。在大型的DBX文件中无法找到邮件表连接的规律，或则在认识上还存在问题，但只要按照文档阐述的方法去解析，是可以完整解析的。"  '添加的文本

    

    '选择文件夹

    With Application.FileDialog(msoFileDialogFolderPicker)

        .AllowMultiSelect = False

        .Title = "请选择文件夹"

        .Show

        If .SelectedItems.Count = 0 Then

            MsgBox "您没有选择一个文件夹，程序将退出！"

            Exit Sub

        End If

        sFolderFullPath = .SelectedItems.Item(1)

    End With

    

    sFileName = Dir(sFolderFullPath & "\*.doc*", vbNormal)

    

    While Len(sFileName) > 0

        sFileFullName = sFolderFullPath & "\" & sFileName

        Set oDoc = Documents.Open(sFileFullName)

        If Not oDoc Is Nothing Then

            oDoc.Content.InsertParagraphAfter   '在文档最后添加一个新的段落，

            oDoc.Paragraphs.Last.Alignment = wdAlignParagraphLeft  '左对齐

            

            oDoc.Paragraphs.Last.Range.Select

            Selection.Text = addText        '将心段落的文字设置为 。。。

            Selection.EndKey        '将插入点移到文档尾部

            'odoc.Save   '保存文档

        End If

        sFileName = Dir  '枚举下一个

    Wend

End Sub

---