Word 2003 - VB Code Does not work like it did in Word 2000

[amrnorman]

Hello,

I created an Access 2000 database that opens up Word 2000 documents for
merging. Within the Word 2000 document version is the following code.
It pulls records from the Access database based upon the record
creation date and a "typist" field. It works like a charm in 2000, but
when it runs from 2003 the message that no records were found displays.
Please help! Thanks.

Private Sub Document_Open()

Dim CreationDate As Variant, Initials As Variant, ErrorNumber As Long

Do

CreationDate = InputBox("Please enter the letter creation date below:"
& vbCrLf & _
vbCrLf & "Date Format: mm/dd/yy", "Und23 Letter - Input Required")
If IsNull(CreationDate) Then Exit Sub

Initials = InputBox("Please enter your initials below:", "Und23 Letter
- Input Required")
If IsNull(Initials) Then Exit Sub


On Error Resume Next

ActiveDocument.MailMerge.DataSource.QueryString = _
"SELECT * FROM [Und23] WHERE (([CreateDate] = #" & CreationDate
& "#) AND ([Typist] = " & Chr(34) & Initials & Chr(34) & "))"

With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.MailAsAttachment = False
.MailAddressFieldName = ""
.MailSubject = ""
.SuppressBlankLines = False
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord

End With
.Execute Pause:=True

End With

ErrorNumber = Err.Number

If ErrorNumber <> 0 Then
If MsgBox("There were no records that matched your search criteria.
Do you want to try again?", vbQuestion Or vbYesNo, "No records found")
= vbNo Then
ErrorNumber = 0
End If
Else
ThisDocument.Close SaveChanges:=wdDoNotSaveChanges
End If
On Error GoTo 0

Loop Until ErrorNumber = 0

End Sub

 

[Cindy M -WordMVP-]

I created an Access 2000 database that opens up Word 2000 documents for

merging. Within the Word 2000 document version is the following code.
It pulls records from the Access database based upon the record
creation date and a "typist" field. It works like a charm in 2000, but
when it runs from 2003 the message that no records were found displays.
Please help! Thanks.

Could you comment out "On Error Resume Next", run your code, and tell us
on which line it's failing? Please also quote the exact message.

Or is the problem occurring before the code even executes?

Based on experience, I'm guessing you're running into this issue:

http://support.microsoft.com?kbid=825765

When this security mechanism is activated (no Registry key to turn it
off), opening a main merge document via code automatically disconnects
the data source. You need to reconnect the data source using the
OpenDataSource method (or set the Registry key).

Private Sub Document_Open()

Dim CreationDate As Variant, Initials As Variant, ErrorNumber As Long

Do

CreationDate = InputBox("Please enter the letter creation date below:"
& vbCrLf & _
vbCrLf & "Date Format: mm/dd/yy", "Und23 Letter - Input Required")
If IsNull(CreationDate) Then Exit Sub

Initials = InputBox("Please enter your initials below:", "Und23 Letter
- Input Required")
If IsNull(Initials) Then Exit Sub


On Error Resume Next

ActiveDocument.MailMerge.DataSource.QueryString = _
"SELECT * FROM [Und23] WHERE (([CreateDate] = #" & CreationDate
& "#) AND ([Typist] = " & Chr(34) & Initials & Chr(34) & "))"

With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.MailAsAttachment = False
.MailAddressFieldName = ""
.MailSubject = ""
.SuppressBlankLines = False
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord

End With
.Execute Pause:=True

End With

ErrorNumber = Err.Number

If ErrorNumber <> 0 Then
If MsgBox("There were no records that matched your search criteria.
Do you want to try again?", vbQuestion Or vbYesNo, "No records found")
= vbNo Then
ErrorNumber = 0
End If
Else
ThisDocument.Close SaveChanges:=wdDoNotSaveChanges
End If
On Error GoTo 0

Loop Until ErrorNumber = 0

End Sub

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

 

[amrnorman]

I created an Access 2000 database that opens up Word 2000 documents for
merging. Within the Word 2000 document version is the following code.
It pulls records from the Access database based upon the record
creation date and a "typist" field. It works like a charm in 2000, but
when it runs from 2003 the message that no records were found displays.
Please help! Thanks.

Could you comment out "On Error Resume Next", run your code, and tell us
on which line it's failing? Please also quote the exact message.

Or is the problem occurring before the code even executes?

Based on experience, I'm guessing you're running into this issue:

http://support.microsoft.com?kbid=825765

When this security mechanism is activated (no Registry key to turn it
off), opening a main merge document via code automatically disconnects
the data source. You need to reconnect the data source using the
OpenDataSource method (or set the Registry key).

Private Sub Document_Open()

Dim CreationDate As Variant, Initials As Variant, ErrorNumber As Long

Do

CreationDate = InputBox("Please enter the letter creation date below:"
& vbCrLf & _
vbCrLf & "Date Format: mm/dd/yy", "Und23 Letter - Input Required")
If IsNull(CreationDate) Then Exit Sub

Initials = InputBox("Please enter your initials below:", "Und23 Letter
- Input Required")
If IsNull(Initials) Then Exit Sub


On Error Resume Next

ActiveDocument.MailMerge.DataSource.QueryString = _
"SELECT * FROM [Und23] WHERE (([CreateDate] = #" & CreationDate
& "#) AND ([Typist] = " & Chr(34) & Initials & Chr(34) & "))"

With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.MailAsAttachment = False
.MailAddressFieldName = ""
.MailSubject = ""
.SuppressBlankLines = False
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord

End With
.Execute Pause:=True

End With

ErrorNumber = Err.Number

If ErrorNumber <> 0 Then
If MsgBox("There were no records that matched your search criteria.
Do you want to try again?", vbQuestion Or vbYesNo, "No records found")
= vbNo Then
ErrorNumber = 0
End If
Else
ThisDocument.Close SaveChanges:=wdDoNotSaveChanges
End If
On Error GoTo 0

Loop Until ErrorNumber = 0

End Sub

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


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

Cindy,

The SQLSecurityCheck in regedit resolved my issue. Thank you!