Insert variables into mailmerge documents
I have the following code that I am attempting to print labels with. The code to identify an individual will be the same for all labels. What I am using the mailmerge for is to cycle through the various labels that we are creating.
I am trying to print out the variable finalOut with a CFLR at the beginning of the mailmerge fields. I haven't had any luck in figuring out how to do it.
Any help is greatly appreciated.
Here is the code:
Private Sub Document_Open()
'Extracts a number from a cell containing text and numbers as well as extracting the alpha chars
'Concatenates them for a label
'Set Variables
Dim myNumber As String
Dim rawNum As String
Dim iCount As Integer
Dim i As Integer
Dim finalOut As String
Dim finalNum As String
Dim finalAlpha As String
'Present user Text Box
myNumber = InputBox("Enter Patient Data", "Label Maker")
'Loop through user input to extract numbers
For iCount = Len(myNumber) To 1 Step -1
If IsNumeric(Mid(myNumber, iCount, 1)) Then
i = i + 1
rawNum = Mid(myNumber, iCount, 1) & rawNum
End If
If i = 1 Then rawNum = CInt(Mid(rawNum, 1, 1))
Next iCount
'Get last 4 numbers of MRN for concat
finalNum = Right(rawNum, 4)
'Returns only the characters from the string
Dim curChar As String
Dim ctr As Integer
For ctr = 1 To Len(myNumber)
curChar = Mid(myNumber, ctr, 1)
If Not (IsNumeric(curChar)) Then
CharsOnly = CharsOnly & curChar
End If
Next
'Display final concatenated output after grabbing info that I need
finalAlpha = Left(Trim(CharsOnly), 1) + Mid(CharsOnly, InStr(Trim(CharsOnly), ",") + 3, 1)
finalOut = finalAlpha + "-" + finalNum
MsgBox (finalOut)
CreateLabels (finalOut)
End Sub
Sub CreateLabels(finalOut As String)
'
' CreateLabels Macro
'
'
ActiveDocument.MailMerge.MainDocumentType = wdMailingLabels
ActiveDocument.MailMerge.OpenDataSource Name:= _
"C:\PetApps\ContrastListing.docm", ConfirmConversions:=False, ReadOnly:= _
False, LinkToSource:=True, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", WritePasswordDocument:="", WritePasswordTemplate:= _
"", Revert:=False, Format:=wdOpenFormatAuto, Connection:="", SQLStatement _
:="", SQLStatement1:="", SubType:=wdMergeSubTypeOther
'I would like to print the value for variable finalOut here as a string along with a CRLF
'I would also like to add CRLF to several fields below
ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
, Text:="""Item"""
ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
, Text:="""Dose"""
ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
, Text:="""Unit"""
ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
, Text:="""Text"""
ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
, Text:="""Expires"""
ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
, Text:="""Time"""
Selection.MoveLeft Unit:=wdCharacter, Count:=33
Selection.TypeText Text:=" "
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.TypeText Text:=" "
Selection.MoveRight Unit:=wdCharacter, Count:=6
Selection.TypeText Text:=" "
Selection.MoveRight Unit:=wdCharacter, Count:=6
Selection.TypeText Text:=" "
Selection.MoveRight Unit:=wdCharacter, Count:=9
Selection.TypeText Text:=" "
ActiveDocument.MailMerge.ViewMailMergeFieldCodes = wdToggle
ActiveDocument.MailMerge.Check
With ActiveDocument.MailMerge
.Destination = wdSendToPrinter
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
End Sub
|