VB6 Word查找並替換標頭後期綁定

Question

I 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

該代碼不是早期綁定本。遲到了。

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

是遲到的，每一個你處理的對象你處理一個遲到的綁定。

Answer 2

我使用的選擇，而不是範圍，現在是工作：

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