Microsoft Office Forums - View Single Post

gmayor · 04-01-2021, 09:30 PM

Assuming the body of the appointment item is as you have described then you can use the Outlook Word Editor to either replace the number with a barcode or append a barcode. As written the macro below will replace the number with a QR barcode and leave the item open. If you close without saving the original item will remain. If you remove the quote from the start of the two lines near the end, the text with barcodes will be copied to the clipboard and the item closed without saving.

Code:

Sub AddBarCode()
'Graham Mayor - https://www.gmayor.com - Last updated - 02 Apr 2021
Dim olItem As AppointmentItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim oPara As Object
Dim i As Integer
Dim sNum As String
    On Error Resume Next
    Select Case Outlook.Application.ActiveWindow.Class
        Case olInspector
            Set olItem = ActiveInspector.currentItem
        Case olExplorer
            Set olItem = Application.ActiveExplorer.Selection.Item(1)
    End Select
    With olItem
        .Save
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        oRng.Text = Replace(oRng.Text, Chr(11), Chr(13))
        For i = 1 To oRng.Paragraphs.Count
            Set oPara = oRng.Paragraphs(i).Range
            oPara.End = oPara.End - 1
            If InStr(1, oPara.Text, ":") > 0 Then
                oPara.moveStartuntil ":"
                oPara.Start = oPara.Start + 2
                sNum = oPara.Text
                'optional next line puts the code after the number
                'oPara.collapse 0
                oRng.Fields.Add oPara, 99, Chr(34) & sNum & Chr(34) & Chr(32) & "QR" & " \t", False
            End If
        Next i
        .Display
        'oRng.Copy
        'olItem.Close olDiscard
    End With
lbl_Exit:
    Exit Sub
End Sub