Selecting Only One Record In A Merge

I sometimes only need to print one envelope from my mail merge list. Thanks
to Peter Jamieson who a wrote who a while ago wrote the following macro for
me which allows me to select a starting letter for the merge. I was
wondering if the macro (I have a hard time spelling macro) could be edited
so that if I inserted a telephone number only that record would pop up in
the envelope.

Sub OneMergePerInitialLetterAskStart()
' error trapping to be added
Dim bDone As Boolean
Dim iLetter As Integer
Dim objMMMD As Word.Document
Dim strColumnName As String
Dim strSheetName As String
Dim strStartLetter As String
bDone = False
Do
strStartLetter = InputBox("Enter the starting letter," & _
" or blank to quit", "Starting letter", "a")
strStartLetter = UCase(Trim(strStartLetter))
If Len(strStartLetter) = 0 Then
bDone = True
Else
If Len(strStartLetter) > 1 Then
MsgBox "Enter a single letter" & _
" (from A to Z or a to z)," & _
" or blank to quit", vbOKOnly
Else
If strStartLetter < "A" _
Or strStartLetter > "Z" Then
MsgBox "Enter a (single) letter" & _
" from A to Z or a to z," & _
" or blank to quit", vbOKOnly
Else
bDone = True
End If
End If
End If
Loop Until bDone

If strStartLetter <> "" Then
' Set this to the name of the worksheet or to the range name
strSheetName = "Nominal Roll$"
' Set this to the exact name of the column containing the name
' (upper/lower case is probably significant
strColumnName = "LastName"

Set objMMMD = ActiveDocument
With objMMMD
For iLetter = Asc(strStartLetter) To Asc("Z")
.MailMerge.DataSource.QueryString = _
" SELECT * FROM [" & strSheetName & "]" & _
" WHERE ucase(" & strColumnName & ") like '" & _
Chr(iLetter) & "%'"
With .MailMerge
' remove or change this as necessary
.Destination = wdSendToNewDocument
On Error GoTo norecords
.Execute Pause:=False
End With
If MsgBox("Completed Letter " & Chr(iLetter) & _
". Do the next letter?", vbOKCancel) = vbCancel Then
Exit For
End If
norecords:
If Err.Number = 5631 Then
' Assume it is because there were no records for this letter
' Not necessarily true - could be just a badly formed query
Err.Clear
On Error GoTo 0
Resume atloop
Else
' just stop
On Error GoTo 0
End If
atloop:
Next
End With
Set objMMMD = Nothing
End If
End Sub


--

Regards
Michael Koerner

Can the phone number only appear in one column in your data source, or
could it be in several? Do your numbers have non-numeric characters,
e.g. extension numbers introduced with "x", international "+" at the
beginning of the number, spaces, etc.?

Peter Jamieson

http://tips.pjmsn.me.uk
Visit Londinium at http://www.ralphwatson.tv

Michael Koerner wrote:
> I sometimes only need to print one envelope from my mail merge list. Thanks
> to Peter Jamieson who a wrote who a while ago wrote the following macro for
> me which allows me to select a starting letter for the merge. I was
> wondering if the macro (I have a hard time spelling macro) could be edited
> so that if I inserted a telephone number only that record would pop up in
> the envelope.
>
> Sub OneMergePerInitialLetterAskStart()
> ' error trapping to be added
> Dim bDone As Boolean
> Dim iLetter As Integer
> Dim objMMMD As Word.Document
> Dim strColumnName As String
> Dim strSheetName As String
> Dim strStartLetter As String
> bDone = False
> Do
> strStartLetter = InputBox("Enter the starting letter," & _
> " or blank to quit", "Starting letter", "a")
> strStartLetter = UCase(Trim(strStartLetter))
> If Len(strStartLetter) = 0 Then
> bDone = True
> Else
> If Len(strStartLetter) > 1 Then
> MsgBox "Enter a single letter" & _
> " (from A to Z or a to z)," & _
> " or blank to quit", vbOKOnly
> Else
> If strStartLetter < "A" _
> Or strStartLetter > "Z" Then
> MsgBox "Enter a (single) letter" & _
> " from A to Z or a to z," & _
> " or blank to quit", vbOKOnly
> Else
> bDone = True
> End If
> End If
> End If
> Loop Until bDone
>
> If strStartLetter <> "" Then
> ' Set this to the name of the worksheet or to the range name
> strSheetName = "Nominal Roll$"
> ' Set this to the exact name of the column containing the name
> ' (upper/lower case is probably significant
> strColumnName = "LastName"
>
> Set objMMMD = ActiveDocument
> With objMMMD
> For iLetter = Asc(strStartLetter) To Asc("Z")
> .MailMerge.DataSource.QueryString = _
> " SELECT * FROM [" & strSheetName & "]" & _
> " WHERE ucase(" & strColumnName & ") like '" & _
> Chr(iLetter) & "%'"
> With .MailMerge
> ' remove or change this as necessary
> .Destination = wdSendToNewDocument
> On Error GoTo norecords
> .Execute Pause:=False
> End With
> If MsgBox("Completed Letter " & Chr(iLetter) & _
> ". Do the next letter?", vbOKCancel) = vbCancel Then
> Exit For
> End If
> norecords:
> If Err.Number = 5631 Then
> ' Assume it is because there were no records for this letter
> ' Not necessarily true - could be just a badly formed query
> Err.Clear
> On Error GoTo 0
> Resume atloop
> Else
> ' just stop
> On Error GoTo 0
> End If
> atloop:
> Next
> End With
> Set objMMMD = Nothing
> End If
> End Sub
>
>