How to Skip Used Mailing Labels and Print Duplicates

One feature that Microsoft Word has, but Microsoft Access does not have, is the ability to choose a starting label. However, moving your ActiveX barcoding application to Word complicates matters because Word does not support Data Binding. This means that there is no control source property, and you cannot simply bind the control a field in your Access Database.

There are 2 solutions to this problem. Both require some VBA Code. The first and easiest solution is to follow the steps in this Microsoft Knowledge Base article: Q95806. This allows you to remain in Access, but also to choose your starting label (and/or create duplicate labels). If you are more confident with VBA or would rather use Word as your labelling tool, we have developed some sample code for Microsoft Word that will loop through all of the records in an Access table and create barcodes on a label document in Word.

To use the code below:

  1. Download the Word 97/2000 Template that will allow you to install this macro and others and jump to step 6 or Copy the Sub Main() Routine to the clipboard by highlighting it and pressing Ctrl + C.
  2. In Microsoft Word, Open the Visual Basic Editor by pressing Alt + F11
  3. Insert a new Module, by clicking on Insert|Module
  4. Paste the code into the module
  5. You must create a reference to Microsoft DAO. Included below is a Macro that can try to create the reference for you. Copy the AddReference macro to your module and run it. If you prefer, you can manually add the reference by going to the Tools Menu in the visual Basic Editor and click on References. Find Microsoft DAO on the list and check the box beside it.
  6. Change a few details in the code to have the macro open the correct database, table and field and also to the create the correct Labels for your application. (The green comments below indicate where you should make your changes.)
 Sub Main()

   ' This is an example of a fairly simple Word macro that will loop
   ' through all the records a table in MSAccess, taking the data
   ' from a field and converting it to barcodes on a MS Word Label
   ' document

   ' NB - you must create a reference to Microsoft DAO for this macro
   ' to work. If you installed this macro using the Install Wizard
   ' that came with the other ActiveX macros then the reference has
   ' already been created. 

   ' Last updated April 2001. 
   ' ---------------------------------------------------------------

   Dim Db, RS, DBName As String, DBTable As String
   Dim i As Long, j As Long, Rcount As Long, nRow, nCol

   ' Name with full path of database to open
   DBName = "C:\Program files\Microsoft Office\Office\" _
   & "SamplesNorthwind.mdb"

   AXMyPath$ = "C:\Temp\"     ' folder must exist
   On Error Resume Next
   MkDIR AXMyPath$
   ' Name of table in Database
   DBTable = "Shippers"

   ' open database (Must create Reference to Microsoft DAO)
   Set Db = OpenDatabase(Name:=DBName)

   ' open Shippers Table
   Set RS = Db.OpenRecordset(Name:=DBTable)

   ' Get Record count (for number of labels)
   Rcount = RS.RecordCount - 1

   ' loop through each record in the table
   For i = 0 To Rcount
      ' Take the value of the first field and pass it to activex
      ' You may use the name of the field or its index number:
      ' e.g. frmMain.TALBarCd1.Message = RS.Fields("fieldname").Value

      frmMain.TALBarCd1.Message = RS.Fields(1).Value
      ' save barcode with record number
      frmMain.TALBarCd1.SaveBarCode AXMyPath$ & "Barcode" & i & ".wmf"
      ' move to next record
   Next 'I
   ' close table, then close Database

   ' Create new empty labels document - change the Name:= attribute
   ' to reflect the type of labels you wish to generate
   Application.MailingLabel.CreateNewDocument Name:="8463", Address:="", _
   AutoText:="", LaserTray:=wdPrinterManualFeed

   ' Set starting column and Row
   nRow = InputBox("Please indicate which Row you would like to start on")
   nCol = InputBox("Please indicate which Column you would like to start on")

   ' Check validity of choices
   If Selection.Information(wdMaximumNumberOfRows) < Val(nRow) Or _
   Selection.Information(wdMaximumNumberOfColumns) < Val(nCol) Or _
   Val(nRow) <= 0 Or Val(nCol) <= 0 Then

      If MsgBox("Row must be between 1 and" + Str(Selection.Information(wdMaximumNumberOfRows))_
       + ". Column must be between 1 and" + Str(Selection.Information(wdMaximumNumberOfColumns))_
       + ". Try again?", vbRetryCancel) = 4 Then
         GoTo SetRow
         GoTo bye
      End If
   End If

   ' move to requested label
   While Selection.Information(wdStartOfRangeRowNumber) < Val(nRow)
      Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdMove

   While Selection.Information(wdStartOfRangeColumnNumber) < Val(nCol)
      Selection.MoveRight Unit:=wdCell, Count:=1

   For j = 0 To Rcount
      ' If current cell is padder then move to the next cell
      If Selection.Information(wdWithInTable) = True Then
         Do While PointsToInches(Selection.Cells.Width) < 1
            Selection.MoveRight Unit:=wdCell
      End If

      ' Insert Barcode
      Selection.InlineShapes.AddPicture FileName:=AXMyPath$ & "barcode" & j & ".wmf", LinkToFile:= _
      False, SaveWithDocument:=True

      ' Move to next cell
      Selection.MoveRight Unit:=wdCell

      On Error Resume Next
      ' Delete last barcode
      Kill AXMyPath$ & "barcode" & j & ".wmf"
      On Error GoTo 0
   Next 'j

End Sub

The Following macro adds the Reference to Microsoft DAO:

 Sub AddReference()

   Dim j, FoundDAORef

   ' Check/AddReferences:
   FoundDAORef = False

   With Documents(ThisDocument.Name).VBProject
      For j = 1 To .References.Count
         If .References(j).Guid = "{00025E01-0000-0000-C000-000000000046}" Then
            FoundDAORef = True
         End If
      Next 'j

      If FoundDAORef = False Then
         'add reference to DAO 3.5 or later
         .References.AddFromGuid "{00025E01-0000-0000-C000-000000000046}", 3, 5
      End If
   End With
End Sub

The following macro removes the reference to DAO:

 Sub RemoveReference()

   Dim j, FoundDAORef, RefObj
   FoundDAORef = False

   With Documents(ThisDocument.Name).VBProject
      For j = 1 To .References.Count
         If .References(j).Guid = "{00025E01-0000-0000-C000-000000000046}" Then
            FoundDAORef = True
         End If
      Next 'j

      If FoundDAORef = True Then
         'remove reference to DAO 3.5 or later
         Set RefObj = .References("DAO")
         .References.Remove (RefObj)
      End If
   End With
   set RefObj = Nothing
End Sub

Contact Us