Excel to word VBA code crashes on find

[misi]

I've separated out the code that fails. I could swear that this used to work. At times, I've seen the error
"The object invoked has disconnected from its clients" and at other times, the code simply crashes and Office asks me whether I want to save my work and restart Excel. My code is as follows:-

Option Base 1
Option Explicit
' To avoid problems for the next 2 lines, select Verktyg, Referenser and then
' select Microsoft Word xx object library. You might have to remove an existing
' one FIRST, THEN add the available one from the list (they vary between Office
' 2003 and 2007)
Public wdApp As Word.Application
Public myDoc As Word.Document

Private Sub Create_document()
'
'
'
Dim template_string As String
Dim mywdRange As Word.Range
'

Set wdApp = New Word.Application ' Create a new word document ......
With wdApp
.Visible = True ' Change this to False, and you WON'T see all the word stuff
.WindowState = wdWindowStateMaximize
End With
'
On Error Resume Next
template_string = ThisWorkbook.Path & "\Agenda.dotx"

Set myDoc = wdApp.Documents.Add(Template:=template_string)
Select Case Err.Number
Case 5151
MsgBox "Cannot open template " & template_string & " - cannot continue"
wdApp.Quit ' close the Word application
Exit Sub
Case Else
' nop
End Select
On Error GoTo 0

wdApp.Selection.Find.ClearFormatting
' The string Other exists in the template. If I record a macro, then apart
' from the extra wdApp. text, the recorded macro is identical to that below
With wdApp.Selection.Find
.Text = "Other" <------- this (or the next line) seem to cause the error
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

wdApp.Selection.Find.Execute

errorHandler:
Set wdApp = Nothing
Set myDoc = Nothing
Set mywdRange = Nothing

End Sub


I've googled and found references to non-qualified objects (?), but as far as I can tell (in my amateur way), there doesn't seem to be anything obviously wrong.

Any suggestions gratefully received.

[Tinbendr]

Use myDoc instead. But better yet, use Range.

Set WrdRng = myDoc.Range
...
WrdRng.Find.ClearFormatting

With WrdRng.Find
...
WrdRng.Find.Execute

[misi]

Can I follow on with a variation (I believe) on the same theme.
(I'm begining to wonder whether MS have blocked some holes that used to exist, since the following code used to work)

First of all, let me say I'm a newbie to VBA for Word (written a fair bit for Excel, but not Word). What I want to do is change various variables in the headers on all pages. I have the following code I found somewhere

Dim date_time As String
date_time = Date & " " & Mid(Time, 1, 5)

Dim rngStory As Word.Range
For Each rngStory In wdApp.ActiveDocument.StoryRanges
With wdApp.rngStory.Find
.text = "Ag_date"
.Replacement.text = Agenda_date
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
With wdApp.rngStory.Find
.text = "Ag_time"
.Replacement.text = Mid(Agenda_time, 1, 5) & " " ' Ensure the room name is alignd correctly
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
With wdApp.rngStory.Find
.text = "Ag_nr"
.Replacement.text = Agenda_number
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
With wdApp.rngStory.Find
.text = "Ag_room"
.Replacement.text = agenda_room
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
With wdApp.rngStory.Find
.text = "Date_time"
.Replacement.text = date_time
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next rngStory
As you can see (?), it simply loops through all the pages changing things like Ag_room to the content of the variable Agenda_room.

When I try running this, I get run-time error 438 on the line marked in red.

Any suggestions as to how I should change it ?

[Tinbendr]

Try
For Each rngStory In wdApp.ActiveDocument.StoryRanges
With rngStory.Find

[fumei]

If you want to work with headers, WHY use StoryRanges? There is no point whatsoever to using StoryRanges if you want to work directly with headers.

[misi]

David - thanks for your reply. The strange thing is that I have to change the code depending on whether I'm running it at work or at home. Note the following

' Dim rngStory As Word.Range ' This works at home
Dim rngStory ' This works at work
The first line fails at work.

Fumei - I would change the code, but I don't know how to (like lots of my code, I google, experiment and use). Feel free to show me how to do it ;)

[fumei]

Assuming all your variables are properly declared and given values...
Assuming Agenda_time is in fact a Date...
Assuming your strings to find have any spaces needed (or not)...
Dim oSec As Section
Dim oHF As HeaderFooter
Dim NEWAgenda_time As Date


NEWAgenda_time = Mid(Agenda_time, 1, 5) & " "

For Each oSec In ActiveDocument.Sections
For Each oHF In oSec.Headers
oHF.Range.Text = Replace(oHF.Range.Text, "Ag_date", Agenda_date)
oHF.Range.Text = Replace(oHF.Range.Text, "Ag_time", NEWAgenda_time)
oHF.Range.Text = Replace(oHF.Range.Text, "Ag_nr", Agenda_number)
oHF.Range.Text = Replace(oHF.Range.Text, "Ag_room", agenda_room)
oHF.Range.Text = Replace(oHF.Range.Text, "Date_time", date_time)
Next oHF
Next oSec

Comments:

Mid requires the additional variable to use in Replace.

Try to be consistent with naming. You use Agenda_number (capitalized), and then agenda_room (not capitalized). It is a minor point....just saying.

The above only operates in the headers. If you need footers, then you need addtional code for them:
........stuff before......
For Each oHF In oSec.Footers
.....stuff after........

[misi]

I had (?) to change the code you wrote to the following for the code to work after which it worked a treat (remember, I'm calling Word from Excel)

Dim oSec As Word.Section
Dim oHF As Word.HeaderFooter
Dim NEWAgenda_time As String

date_time = Date & " " & Mid(Time, 1, 5)

'NEWAgenda_time = Mid(Agenda_time, 1, 5) & " "

'
For Each oSec In wdApp.ActiveDocument.Sections
For Each oHF In oSec.Headers
oHF.Range.text = Replace(oHF.Range.text, "Ag_date", Agenda_date)
oHF.Range.text = Replace(oHF.Range.text, "Ag_time", NEWAgenda_time)
oHF.Range.text = Replace(oHF.Range.text, "Ag_nr", Agenda_number)
oHF.Range.text = Replace(oHF.Range.text, "Ag_room", agenda_room)
oHF.Range.text = Replace(oHF.Range.text, "Date_time", date_time)
Next oHF
Next oSec


Having said, there was a difference in the 2 methods. In the original template, the header fonts are Times New Roman 18. Your suggested solution resulted in the header fonts being changed from 18 to 12. Could that have anything to do with previous inserts into the template I'd done (where I've used TNR 12 as the font) ?

If so, is there a simple method of retaining the original header fonts ?

[Frosty]

Does this work?

Sub Tester()

Dim oSec As Word.Section
Dim oHF As Word.HeaderFooter
Dim NEWAgenda_time As String
Dim oFont As Font
date_time = Date & " " & Mid(Time, 1, 5)

'NEWAgenda_time = Mid(Agenda_time, 1, 5) & " "

'
For Each oSec In wdApp.ActiveDocument.Sections
For Each oHF In oSec.Headers
Set oFont = oHF.Range.Font.Duplicate
oHF.Range.Text = Replace(oHF.Range.Text, "Ag_date", Agenda_date)
oHF.Range.Text = Replace(oHF.Range.Text, "Ag_time", NEWAgenda_time)
oHF.Range.Text = Replace(oHF.Range.Text, "Ag_nr", Agenda_number)
oHF.Range.Text = Replace(oHF.Range.Text, "Ag_room", agenda_room)
oHF.Range.Text = Replace(oHF.Range.Text, "Date_time", date_time)
oHF.Range.Font = oFont
Next oHF
Next oSec
End Sub

[misi]

However, after googling, I found this site ( http://msdn.microsoft.com/en-us/library/aa213140%28v=office.11%29.aspx ) which then led me to the following code which seems to work

For Each oSec In wdApp.ActiveDocument.Sections
For Each oHF In oSec.Headers
oHF.Range.Font.Size = 18
oHF.Range.text = Replace(oHF.Range.text, "Ag_date", Agenda_date)
oHF.Range.text = Replace(oHF.Range.text, "Ag_time", NEWAgenda_time)
oHF.Range.text = Replace(oHF.Range.text, "Ag_nr", Agenda_number)
oHF.Range.text = Replace(oHF.Range.text, "Ag_room", agenda_room)
oHF.Range.text = Replace(oHF.Range.text, "Date_time", date_time)
Next oHF
Next oSec