Open .doc, pick out key words and save with key words - REVISITED

[aarondewberry]

Hi all

This a follow up of the thread i started: thread705-1506980

I was given some code by Remou that allows me to open all .doc's in a folder, find an underlined Word, 'strProduct', find a value and add 300 to it, 'strPrice', then save the document with the strProduct and strPrice.

I have come into a problem though. Some of the .doc's have tables of data under the paragraph i want to interrogate and within these tables some of the cells have "_" in them. This is throwing out the IF statement at the end of the code. So when there is a doc with no word underlined and there is a table with, "_", in it, the strProduct value becomes nothing and gives a runtime error on save of the document.

Having said all that.
The underlined word will appear in the first two sentences only. So, is there a way of adapting the strProduct part of the code, to only look at the first 3 lines or the first two sentences of my doc. That way, the table would not come into play and if there is no underlined word, then the ELSE part of the statement would trigger.

Sorry all to revisit this again. But its a large thorn I need to get removed.

Any help will be much appreciated

Thanks

Open .doc, pick out key words and save with key words
thread705-1506980

Sub ProcessWordDocs()
Dim wd As Object 'Word.Application
Dim doc As Object 'Word.Document
Dim aDoc
Dim strDoc As String
Dim strProduct As String
Dim strPrice As String
Dim strDocName
Dim rs As DAO.Recordset
Dim rsProc As DAO.Recordset

   'On Error GoTo ProcessWordDocs_Error

    Set wd = CreateObject("Word.Application")
    wd.Visible = True
    aDoc = Dir("C:\Docs\*.doc")
    
    Do While aDoc <> ""
    
        strDoc = "C:\Docs\" & aDoc
        Set doc = wd.Documents.Open _
            (FileName:=strDoc, AddToRecentFiles:=False)
        
   [red]         wd.selection.Find.ClearFormatting
            wd.selection.Find.Font.Underline = 1 'wdUnderlineSingle
            wd.selection.Find.Text = ""
            wd.selection.Find.Wrap = 1 'wdFindContinue

            wd.selection.Find.Execute
            
            If wd.selection.Find.Found Then
                strProduct = wd.selection.range
            Else
                strProduct = "NONE: " & aDoc
            End If [/red]
        
            wd.selection.Find.ClearFormatting
            wd.selection.Find.Text = "Selling to you for $"
            wd.selection.Find.Wrap = 1 'wdFindContinue
            
            wd.selection.Find.Execute

            'wdWord=2, wdExtend=1
            If wd.selection.Find.Found Then
                wd.selection.MoveRight Unit:=2, Count:=1, Extend:=1
                strPrice = Mid(wd.selection.range, InStr(wd.selection.range, "$") + 1)
                strDocName = "C:\Docs\Proper\" & strProduct & "_$" & strPrice & ".doc"
                strPrice = strPrice + 300
                wd.selection.range.Text = "Selling to you for $" & strPrice 
                doc.saveas strDocName
            Else
                strPrice = "NONE: " & aDoc
            End If
        
        doc.Close
        
        Debug.Print strProduct, strPrice


        aDoc = Dir
    Loop
    
    Set doc = Nothing
    wd.Quit
    Set wd = Nothing
End Sub

 

[Remou]

What solution do you suggest, based on your recent research in thread707-1507984?



.

 

[aarondewberry]

Thanks for the response

I have tried to incorporate that within the code. See below.

But I keep getting an error saying the 'command is not available as no document is open' on the Set r = ActiveDocument.Sentences(j) line.
I thought the doc is opened via wd.Documents.Open

..........

    Set wd = CreateObject("Word.Application")
    wd.Visible = True
    aDoc = Dir("C:\Docs\*.doc")

    Do While aDoc <> ""
    
        strDoc = "C:\Docs\" & aDoc
        Set doc = wd.Documents.Open _
            (FileName:=strDoc, AddToRecentFiles:=False)
    For j = 1 To 3
    Set r = ActiveDocument.Sentences(j)
    With r.Find
            .ClearFormatting
            .Font.Underline = 1 'wdUnderlineSingle
            .Text = ""
            .Wrap = 1 'wdFindContinue

            r.Find.Execute

            If r.Find.Found = True Then
            strProduct = r
            Else
            strProduct = "NONE: " & aDoc
            End If
   End With
   Next

   ...............

 

[Remou]

Try:


Set r = doc.Sentences(j)

 

[aarondewberry]

Thanks Remou. I have modified that but now...

the code now falls down at:

.Clearformatting

Invalid procedure, call or arguement.

So i commented out .Clearformatting and tried again.
It then fell down on the next line .Font.Underline = 1

Object variable or with block variable not set

I am obviously doing something fundamentally wrong here.

 

[Remou]

Look over your code again. Ensure that you have used the document object, in my sample code it was doc. I have tested, and this simple change means the code will work.

 

[PHV]

Hopefully you didn't use the On Error Resume Next instruction ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[aarondewberry]

Thanks for the repsonse guys.
I have used the document object and no On Error has been written in a yet.

Strange thing is... that when I use the code in the office, using MSACCESS 2000, I keep getting the same errors.
I tried the same code, at home last night, using 2003, and no errors came up.
Strange....

Anyways, thanks for all your time guys, I think we are there.

Cheers