How do you create mailing labels in Notes?

The Lotus Approach database program has built-in support for Avery labels and can read from a Notes database directly.

Intelliprint from CSS can print labels from Notes views.

NotesToPaper by SoftVision Development.

Ulrich-Krause posted this example of using OLE Automation to create labels in MS Word:

Sub Click(Source As Button)
  ' This is how you call it from a view (it uses all documents in the view)
  Call CreateMailingLabels("Subject","Subject","Subject","Subject","Subject")
End Sub


Sub CreateMailingLabels(Line1Fields As Variant,Line2Fields As Variant,Line3Fields As Variant,Line4Fields As Variant,Line5Fields As Variant)
  ' requires MS Word 97 or Word 2000
  ' works on any Notes view or folder
  ' supply list of Notes field names to be concatenated onto each line of the
  ' label in the parameters Line1Fields etc
  '
  ' e.g.
  '
  ' Call CreateMailingLabels_
  '   ("FirstName,LastName","HouseNo,Street","Town","County","PostCode")

  On Error Goto ErrorProc

  ' declare Notes back-end objects
  Dim session As New notessession
  Dim db As notesdatabase
  Dim doc As NotesDocument
  Dim dc As NotesDocumentCollection 
  Set db = session.currentdatabase
  Dim settings As NotesDocument
  Set settings=db.GetProfileDocument("Settings","")

  ' declare Notes front-end objects 
  Dim ws As New NotesUIWorkspace 

  Set dc=db.UnProcessedDocuments

  ' Find out active Notes view
  Dim view As NotesView
  Dim UIView As NotesUIView
  Set view = UIView.View

  ' declare constants

  wdCell = 12 'Microsoft Word VBA constant. Designates unit for table cell.
  wdLine=5
  wdCustomLabelA4 = 2
  cr = Chr(13) & Chr(10) ' Carriage return.

  SelectedDocuments=Messagebox("Do you want to use all the addresses in this view?",35,db.Title) 
  If SelectedDocuments=2 Then
    Messagebox "Merge Cancelled",16,db.Title
    Exit Sub
  End If

  If SelectedDocuments=7 Then
    TickBased%=True
  End If
  ' get required template from user

  LabelTemplate = Inputbox("Please enter the MS Word mailing label name to use. ", db.Title,"Avery L7413")

  ' trim off "Avery" prefix if used 
  LabelTemplateName=LabelTemplate 
  If Left$(LabelTemplate,5)="Avery" Then
    LabelTemplate=Trim$(Right$(LabelTemplate,Len(LabelTemplate)-5))
  End If
  If Instr(LabelTemplate,"-")>1 Then
     LabelTemplate=Trim$(Left$(LabelTemplate,Instr(LabelTemplate,"-")-1))
  End If
  If LabelTemplate="" Then
    Messagebox "Merge Cancelled",16,db.Title
    Exit Sub
  End If

  ' Create an instance of Excel
  Dim wrd As Variant 
  Set wrd = CreateObject("word.application")

  ' create a new Word document only if required 
  If wrd.documents.count=0 Then
    Call wrd.documents.add 
  End If

  ' create new mailing lanels 
  Print "Generating ";LabelTemplateName;" mailing labels in MS Word"
  On Error Goto TrapTemplateName 
  Call wrd.MailingLabel.CreateNewDocument(LabelTemplate)
  On Error Goto ErrorProc

  ' create each mailing label from line of Notes view

  LabelCount!=0
  If TickBased% Then
    Set doc=dc.GetFirstDocument
  Else
    Set doc=view.GetFirstDocument 
  End If
  While Not doc Is Nothing

    ' build label text

    LabelAddress = GetListFieldValues(doc,Line1Fields) & cr
    LabelAddress = LabelAddress & GetListFieldValues(doc,Line2Fields) & cr
    LabelAddress = LabelAddress & GetListFieldValues(doc,Line3Fields) & cr
    LabelAddress = LabelAddress & GetListFieldValues(doc,Line4Fields) & cr
    LabelAddress = LabelAddress & GetListFieldValues(doc,Line5Fields)

    If Not SingleColumn% Then
      Call wrd.Selection.TypeText(LabelAddress) ' Insert full address into Word.
      On Error Goto TrapSingleColumn
      Call wrd.Selection.MoveRight(wdCell) ' Move one cell to the right. 
      On Error Goto ErrorProc
      If SingleColumn% Then
        Call wrd.MailingLabel.CreateNewDocument(LabelTemplate,LabelAddress) 
      End If
    Else
      Call wrd.MailingLabel.CreateNewDocument(LabelTemplate,LabelAddress) 
    End If
    LabelCount!=LabelCount!+1
    If TickBased% Then
      Set doc = dc.GetNextDocument(doc)
    Else
      Set doc = view.GetNextDocument(doc)
    End If
  Wend
  If TickBased% Then
    Print LabelCount!;" labels created from selected addresses" 
  Else
    Print LabelCount!;" labels created from this Notes view (";SheetTitle$;")"
  End If
  REM Make the instance visible to the user
  wrd.visible = True

Exit Sub

TrapTemplateName:
  Messagebox "Incorrect Template Name",16,db.Title
  Exit Sub

TrapSingleColumn:
  Print "Detected non-table labels and changing behaviour accordingly" 
  SingleColumn%=True
  Resume Next
  ErrorProc:
  Print "(";Erl;") ";Error$
  Resume Next

End Sub


Function GetListFieldValues(doc As NotesDocument, FieldList As Variant) As String
  Dim TempList As String
  Dim TempOutput As String
  Dim TempArray As Variant
  Dim ThisField As String

  TempList=FieldList
  TempOutput=""
  If TempList<>"" Then
    ' parse list of fields 
    While Len(TempList)>0
      If Instr(TempList,",")>0 Then
        ThisField=Trim(Left$(TempList,Instr(TempList,",")-1))
        TempList=Right$(TempList,Len(TempList)-Instr(TempList,","))
      Else
        ThisField=Trim(TempList)
        TempList=""
      End If
      ' retrieve notes field 
      If Instr(ThisField,"(")>0 And Instr(ThisField,")")>0 Then
        ThisFieldTemp$=Right$(ThisField,Len(ThisField)-Instr(ThisField,"("))
        ThisFieldIndex%=Val(Left$(ThisFieldTemp$,Len(ThisFieldTemp$)-1))
        ThisField=Left$(ThisField,Instr(ThisField,"(")-1)
      Else
        ThisFieldIndex%=-1
      End If
      TempArray=doc.GetItemValue(ThisField)
      If ThisFieldIndex%>=0 Then
        If Ubound(TempArray)>=ThisFieldIndex% Then 
          TempOutput=TempOutput+" "+TempArray(ThisFieldIndex%)
        End If
      Else
        TempOutput=TempOutput+" "+TempArray(0) 
      End If
    Wend
  End If
  GetListFieldValues=TempOutput
End Function

Applies to Notes Versions: 3, 4, 4.5, 4.6, 5