Selection Find Style not Working 1

[CPForecast]

Hello,

I have a macro that is technically being written for Excel XP, but the part of the program that isn't working involves searching a word document for a particular style.

The program loops through several thousand file paths and names in an excel document. Among other things, the program then takes the path and file name and opens it. From there, the program is supposed to find and copy any "Heading 1" style text. That's the part that seems to be failing. Code below:

Static Function GetWordTitle(path As String, FileName As String) As String

Dim wdApp As Word.Application, wdDoc As Word.Document

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then 'Word isn't already running
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0

Set wdDoc = wdApp.Documents.Open(path + "\" + FileName)
wdApp.Visible = True

wdDoc.Activate

'###################################### 
'FIND TEXT WITH HEADING STYLE NOT WORKING '######################################

With wdApp
    .Selection.Find.ClearFormatting
    .Selection.Find.Style = ActiveDocument.Styles("Heading 1")
    .Selection.Find.ParagraphFormat.Borders.Shadow = False
    With .Selection.Find
        .Text = "This is a test."
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    .Selection.Find.Execute
    .Selection.Copy
End With
'###################################### 
'FIND TEXT WITH HEADING STYLE NOT WORKING '######################################
                
'Copy title from clipboard
Dim MyData   As DataObject
Dim strClip As String

Set MyData = New DataObject
MyData.GetFromClipboard
strClip = MyData.GetText
 
 
'Close the document
wdApp.ActiveDocument.Close (wdDoNotSaveChanges)
'Close out of Word
wdApp.Quit (wdDoNotSaveChanges)
                 
                 
GetWordTitle = strClip

End Function

The thing that's killing me is that i can do a

.Selection.TypeText "This is a test."

right at the beginning of the "With" and it'll add it to the beginning of the document just fine.

Any ideas on why this find might not be working would be much appreciated. Thanks!

 

[CPForecast]

fumei,

I also took a look at this thread here with your respose to a question about headers and footers of different types:

http://www.tek-tips.com/viewthread.cfm?qid=1435364&page=13

Since even, odd, and first page headers and footers are all different in my project and each header and footer contains text of various formatting (odd footers even insert an image), I was thinking about working with this example that you posted:

Sub AnotherWay()
Dim ThisDoc As Document
Dim oHF As HeaderFooter
Dim var
Dim HeaderText()
Dim FooterText()
HeaderText = Array("Header Odd", "Header First", "Header Even")
FooterText = Array("Footer Odd", "Footer First", "Footer Even")
Set ThisDoc = ActiveDocument

With ThisDoc.PageSetup
    .DifferentFirstPageHeaderFooter = True
    .OddAndEvenPagesHeaderFooter = True
End With

For var = 1 To 3
    ThisDoc.Sections(1).Headers(var).Range.Delete
    ThisDoc.Sections(1).Footers(var).Range.Delete
Next var

With ThisDoc.Sections(1)
    For var = 1 To 3
            .Headers(var).Range.Text = HeaderText(var - 1)
            .Footers(var).Range.Text = FooterText(var - 1)
    Next
End With
End Sub

As far as the headers and footers go, I can start from scratch and pull in new data every time, so I don't need to worry about searching for replacing there. Does it make sense to work with something like the above example?

 

[fumei]

Yes.

faq219-2884

Gerry
My paintings and sculpture