Selection Find Style not Working

CPForecast · #1 (**permalink**) September 15th, 2008, 11:32 AM

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:

Code:

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 = ""
        .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

Code:

.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!

Shasur · #2 (**permalink**) September 16th, 2008, 01:07 AM

Hi

Are you sure that you need - Selection.Find.ParagraphFormat.Borders.Shadow = False

Here is the slightly modifed code that works for me

Code:

'######################################
'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 = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    .Selection.Find.Execute
    If wdApp.Selection.Find.Found = True Then
        .Selection.Copy
    End If
End With
'######################################
'FIND TEXT WITH HEADING STYLE NOT WORKING
'######################################

Cheers
Shasur

http://www.dotnetdud.blogspot.com

VBA Tips & Tricks (http://www.vbadud.blogspot.com)

CPForecast · #3 (**permalink**) September 16th, 2008, 10:27 AM

@Shasur- Removing that line worked once. However, how I seem to be getting a:

Error 429, "ActiveX Can't Create Object"

Nothing else has changed except for removing that one line. It fails on this line:

Code:

Set wdApp = GetObject(, "Word.Application")

Does anyone have any thoughts? Thanks.

CPForecast · #4 (**permalink**) September 16th, 2008, 01:18 PM

I have solved the Error 429 by removing:

Code:

'Set wdApp = GetObject(, "Word.Application")

Thank you for the help. I very much appreciate it!

Niall · #5 (**permalink**) November 30th, 2009, 11:03 PM

I have exactly the same issue, but I'm already doing the late binding and its still falling over on the line

With .Selection.Find
.Text = "Fred"

I've also tried
Application.Selection.Find.Text = "Fred"
to no avail.

I'm using this in a vb6 & MS Word (professional) 2003 environ, ref to Microsoft word object 11.0 library sitting on an XP box with all relevant service packs applied.

I've also tried the "winword.exe /r" fix that I found on msdn - also didn't work.

Niall · #6 (**permalink**) November 30th, 2009, 11:40 PM

Found my own answer: (I'm doing this in the footer of every document, which is why I'm doing the 'activewindow' bit)

Code:

                With .ActiveDocument.ActiveWindow.Selection.Find
                    strFind = "FindMe"
                    strReplace = ""
                    .Execute FindText:=strFind, Replace:=wdReplaceAll, ReplaceWith:=strReplace
                    strFind = "Replacement"
                    .Execute FindText:=strFind, Replace:=wdReplaceAll, ReplaceWith:=strReplace
                End With

Need to download code?

Navigation