Question

我found this code用于查找和替换Word文件中的VB6，但它是早期绑定的。

但是我需要它进行后期绑定，因为我的EXE将用于不同的系统，因此我不能使用参考Word库。

我的代码需要做的是：在所有Word文件中查找红色文本，并将其替换为隐藏字体。

我让它为主要文本工作，但标题也包含红色文本，也需要隐藏。

这是我当前的代码，不再替换任何内容。

Private Sub PREP_Click()
Const wdColorRed = 255
Dim oWordApp As Object
On Error Resume Next
Dim fs As Object
Dim rngStory As Object
Dim lngJunk As Long
Dim oFolder As Object
Dim tFolder As Object
Dim oFile As Object
Dim strDocName As String
Dim strPathName As String
Dim locFolder As String
    locFolder = InputBox("Enter the folder path to the file(s) your want to prepare.", "File Preparation", "Type your path here... Make sure it end with a back slash, e.g. C:\myfiles\")
Set fs = CreateObject("Scripting.FileSystemObject")
Set oFolder = fs.GetFolder(locFolder)
Set tFolder = fs.CreateFolder(locFolder & "PREP")
Set tFolder = fs.GetFolder(locFolder & "PREP")
Set oWordApp = CreateObject("Word.Application")
Set rngStory = CreateObject("Word.Range")
For Each oFile In oFolder.Files
oWordApp.Visible = False
oWordApp.Documents.Open (oFile.Path)
lngJunk = oWordApp.ActiveDocument.Sections(1).Headers(1).range.StoryType
'Iterate through all story types in the current document
For Each rngStory In oWordApp.ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
  With oWordApp.rngStory.Find
oWordApp.rngStory.WholeStory
oWordApp.rngStory.Find.Font.Hidden = True
oWordApp.rngStory.Find.Replacement.Font.Hidden = False
oWordApp.rngStory.Find.Execute Replace:=2
End With
  'Get next linked story (if any)
  Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
strDocName = oWordApp.ActiveDocument.Name
oWordApp.ChangeFileOpenDirectory (tFolder)
oWordApp.ActiveDocument.SaveAs FileName:=strDocName
oWordApp.ChangeFileOpenDirectory (oFolder)
Next oFile
oWordApp.Quit
Set rngStory = Nothing
Set oWordApp = Nothing
End Sub

我认为问题是rngStory部分。请帮忙！

Answer 1

那段代码不是早期的Ben。它已经晚了。

Dim oWordApp As Object
Set oWordApp = CreateObject("Word.Application")

是迟到的，每次处理对象的地方都会处理后期绑定。

Answer 2

我使用了Selection而不是Range，它现在正在使用：

Private Sub PREP_Click()
Const wdColorRed = 255
    Dim oWordApp As Object
    On Error Resume Next
    Dim fs As Object
    Dim rngStory As Object
    Dim myDoc As Object
    Dim oFolder As Object
    Dim tFolder As Object
    Dim oFile As Object
    Dim strDocName As String
    Dim strPathName As String
    Dim locFolder As String
        locFolder = InputBox("Enter the folder path to the file(s) your want to prepare.", "File Preparation", "Type your path here... Make sure it end with a back slash, e.g. C:\myfiles\")
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set oFolder = fs.GetFolder(locFolder)
    Set tFolder = fs.CreateFolder(locFolder & "PREP")
    Set tFolder = fs.GetFolder(locFolder & "PREP")
    Set oWordApp = CreateObject("Word.Application")
    For Each oFile In oFolder.Files
    oWordApp.Visible = False
    oWordApp.Documents.Open (oFile.Path)
    oWordApp.ActiveDocument.Sections(1).Headers(1).Range.Select
    oWordApp.Selection.WholeStory
    oWordApp.Selection.Find.Font.Color = wdColorRed
    oWordApp.Selection.Find.Replacement.Font.Hidden = True
    oWordApp.Selection.Find.Execute Replace:=2
    oWordApp.ActiveDocument.Select
    oWordApp.Selection.WholeStory
    oWordApp.Selection.Find.Font.Color = wdColorRed
    oWordApp.Selection.Find.Replacement.Font.Hidden = True
    oWordApp.Selection.Find.Execute Replace:=2

    strDocName = oWordApp.ActiveDocument.Name
    oWordApp.ChangeFileOpenDirectory (tFolder)
    oWordApp.ActiveDocument.SaveAs FileName:=strDocName
    oWordApp.ChangeFileOpenDirectory (oFolder)
    Next oFile
    oWordApp.Quit
    Set oWordApp = Nothing
    End Sub

VB6 Word在标题Late Bound中查找和替换

2 个答案: