Macro error on first run, works thereafter (mail merge 2003)

[Kiwi User]

This is a really weird one.

In Word 2002 my merge macro worked fine. In 2003 I get a "window currently
open" error.

Now the really weird thing is, if I ensure NOTHING (including the Document1
window) is open, and run the script it works fine. Every merge thereafter
(whether a document is open or not) also works fine. It is just the FIRST
merge.

Can anyone point me in the right direction to find the error? I can't even
do the VB step through because as far as the macro is concerned, no other
window is open so it works fine :|

TIA

 

[Cindy M.]

Hi =?Utf-8?B?S2l3aSBVc2Vy?=,

I've never heard of or seen anything like what you describe. But it might help
if you showed us the code that's causing the problem? This is a macro in Word
VBA (because you mention VB without the "A")?

Also, what's the exact error number and message? And what's in the title bar
of the error message?

N Word 2002 my merge macro worked fine. In 2003 I get a "window currently
open" error.

Now the really weird thing is, if I ensure NOTHING (including the Document1
window) is open, and run the script it works fine. Every merge thereafter
(whether a document is open or not) also works fine. It is just the FIRST
merge.

Can anyone point me in the right direction to find the error? I can't even
do the VB step through because as far as the macro is concerned, no other
window is open so it works fine :|

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 17 2005)
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question or
reply in the newsgroup and not by e-mail

 

[Kiwi User]

Hi Cindy,

I did say it's very weird!! lol.

Error message is 5479
"you cannot close Microsoft Office Word because a dialog box is open. click
OK, switch to word, and then close the dialog box" End is the only option.

As I said before, this worked perfectly in 2002. If I have no document open
at all, it will run fine, and irrespective of what is open, run ok from
thereon.

The code is as follows:

Private Sub CommandButton1_Click()

If ComboBox1.Value = "" Then
frmMergeData.Hide
Result = MsgBox("You must enter a File Name eg:  20020367.mer",
vbExclamation)
frmMergeData.Show
Exit Sub
End If

'check to see if file exists
extension = Right(ComboBox1.Value, 4)
If extension <> LCase(".mer") Then
Mergefile = ComboBox1.Value & ".mer"
Else
Mergefile = ComboBox1.Value
End If

FileExists = Dir(txtMergeDataDir & Mergefile)
If FileExists = "" Then
frmMergeData.Hide
Result = MsgBox("The filename you entered doesn't.  Please try
again.", vbExclamation)
frmMergeData.Show
Exit Sub
Else
Documents.Open FileName:=txtMergeDataDir & Mergefile,
Format:=wdOpenFormatText
End If

'write to ini file
NumDataFiles = System.PrivateProfileString(txtUserDefaultsDir &
"UserDefaults.ini", "Details", "NumDataFiles")
If NumDataFiles = "" Then
NewNumber = "1"
End If
If NumDataFiles = "1" Then
NewNumber = "2"
End If
If NumDataFiles = "2" Then
NewNumber = "3"
End If
If NumDataFiles = "3" Then
NewNumber = "4"
End If
If NumDataFiles = "4" Then
NewNumber = "5"
End If
If NumDataFiles = "5" Then
NewNumber = "6"
End If
If NumDataFiles = "6" Then
NewNumber = "1"
End If
System.PrivateProfileString(txtUserDefaultsDir & "UserDefaults.ini",
"Details", "DataFile" & NewNumber) = Mergefile
System.PrivateProfileString(txtUserDefaultsDir & "UserDefaults.ini",
"Details", "NumDataFiles") = NewNumber

Unload frmMergeData
On Error Resume Next
Application.CommandBars("Tools").Controls("iMana&ge Mail
Merge...").Execute
Application.CommandBars("Tools").Controls("iMana&ge Mail
Merge...").Execute
Application.Windows(FileExists).Close



Test = ActiveDocument.BuiltInDocumentProperties(18)

'remove old bneprec filename from footer
With ActiveDocument.Bookmarks  'Set CurrentPositionBookmark
.Add Range:=Selection.Range, Name:="CurrentPosition"
End With

Count = 0
NumSections = ActiveDocument.Sections.Count
While Count < NumSections
Count = Count + 1

With ActiveDocument.Sections(Count).Footers(wdHeaderFooterFirstPage)
.Range.Select
Selection.EndKey Unit:=wdStory
End With  'now inside footer

If Test = "KeepFooter" Then
'remove bneprecs reference.
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "BNEPREC"   'character class in brackets
.Forward = True
.Replacement.Text = ""
End With
While Selection.Find.Execute = True
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Wend
Else
Selection.WholeStory
Selection.Delete
End If
ActiveWindow.View.ShowFieldCodes = True
ActiveWindow.ActivePane.Close
Wend

'do same for primary footer
Count = 0
NumSections = ActiveDocument.Sections.Count
While Count < NumSections
Count = Count + 1

With ActiveDocument.Sections(Count).Footers(wdHeaderFooterPrimary)
.Range.Select
Selection.EndKey Unit:=wdStory
End With  'now inside footer
ActiveWindow.View.ShowFieldCodes = True

If Test = "KeepFooter" Then
'remove bneprecs reference.
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "BNEPREC"   'character class in brackets
.Forward = True
.Replacement.Text = ""
End With
While Selection.Find.Execute = True
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Wend
Else
Selection.WholeStory
Selection.Delete
End If

'        Selection.WholeStory
'        Selection.Delete
ActiveWindow.View.ShowFieldCodes = True
ActiveWindow.ActivePane.Close
Wend

ActiveWindow.View.ShowFieldCodes = False

If ActiveWindow.View.SplitSpecial = wdPaneNone Then
ActiveWindow.ActivePane.View.Type = wdNormalView
Else
ActiveWindow.View.Type = wdNormalView
End If
If ActiveWindow.View.SplitSpecial = wdPaneNone Then
ActiveWindow.ActivePane.View.Type = wdPrintView
Else
ActiveWindow.View.Type = wdPrintView
End If

Err1:
Select Case Err.Number
Case 4605   ' error going to next header footer
GoTo finish
Case 5941
GoTo finish
Case 4198
GoTo finish
'                x = MsgBox("There is a problem with the footer in this
document.  " _
'                & "The iManage document ID may not have been added to the
footer(s).", vbExclamation, "Gaden's Macro Prompt")
End Select

finish:
ActiveWindow.View.ShowFieldCodes = False
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
ActiveDocument.BuiltInDocumentProperties(18) = ""

End
End Sub

Private Sub CommandButton2_Click()
Unload Me
End
End Sub


Private Sub UserForm_Initialize()

Count = 0
While Count <> 6
Count = Count + 1
x = System.PrivateProfileString(txtUserDefaultsDir &
"UserDefaults.ini", "Details", "DataFile" & Count)
ComboBox1.AddItem x
Wend

End Sub

 

[Cindy M.]

As I said before, this worked perfectly in 2002. If I have no document open

at all, it will run fine, and irrespective of what is open, run ok from
thereon.

The code is as follows:

OK... Now which line of code is generating the error?

And why do you have On Error Resume Next in there with no On Error Goto 0
immediately following? Plus two .Execute methods on the same toolbar control?

I think it's likely that On Error Resume Next is masking the real cause of the
problem. Comment that out, for starters.

You also need to track down what that Execute methods is doing.

And what is the data source type? A Word document table?

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 17 2005)
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question or reply
in the newsgroup and not by e-mail