Barcode Font Macro

komobu · #1 04-01-2021, 07:21 AM

I have an Outlook Calendar Item that has 6 Entries on it from 4 digits to 17 digits each. These 6 entries have to be entered /typed into a web page.

Example as follows

Item1: 1GM4546745UR34268
Item2: 98123
Item3: XHD3793
Item4: 4568
Item5: C0049750
Item6: 45654565

What I would like to do is have a macro that would add a tab space after each entry, and duplicate the entry as a barcode font. so it would look like the following:

Item1: 1GM4546745UR34268 BARCODEHERE
Item2: 98123 BARCODEHERE
Item3: XHD3793 BARCODEHERE

Item4: 4568 BARCODEHERE
Item5: C0049750 BARCODEHERE
Item6: 45654565 BARCODEHERE

If I am able to accomplish this, I can use a barcode gun to enter the data in the webpage instead of try to type each item in manually.

Any help with this macro would be appreciated

komobu · #2 04-01-2021, 08:03 AM

Another way that would work is if there was a macro to "Select" all text on the right of the colon on each line. Then I could quickly convert the text to Barcode Font, and enter into webpage. When I exited the item, I just wouldnt save it so it would revert back to readable text.

gmayor · #3 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

komobu · #4 04-03-2021, 05:18 AM

Thanks for your help.

Initially I was getting an syntax error, but I was trying to add your code to one of my other modules. I added a new module, and pasted your code and no errors are returned.

When I run the macro however, nothing happens. No screen flash or anything visible at all.

I checked the clipboard and there was noting in it.

I removed the quote from the two lines near the end (oRng.Copy) and (olItem.Close olDiscard) Re ran the macro and again nothing. Also checked the clipboard by using "Control V" and nothing is there.

Here is a copy of what my calendar item looks like with data in it:

VIN: 1GMZU62hX3ZA92085
Od: 200236
Plate: XYG7365

State Inspection
Sticker Number: X0337728
Insert Number: 22944514

Not sure if it matters, I am using Outlook 2010. I dont know that I have anything installed in outlook for QR Codes.

I am using Code 39 which is a Barcode font that I installed. If I add an asterisk to the beginning of the alphanumeric and to the end, my barcode reader will read it. Without those asterisks, the code reader will not read it.
So the Plate for example would be *XYG7365*

One thing I realized was as soon as I add an asterisk to the front and rear, the font gets changed to bold. I have to find out how to turn that setting off.

I am also wondering if it may be easier to convert my calendar item to the following:

VIN:
*1GMZU62hX3ZA92085*

Od:
*200236*

Plate:
*XYG7365*

State Inspection

Sticker Number:
*X0337728*

Insert Number:
*22944514*

This way I could actually just highlight the lines myself and change the font. But I really would like to get a macro to do it.

Thanks again for your help

komobu · #5 04-28-2021, 01:06 PM

Graham;

I removed Outlook 2010 and am only using outlook 365 on my pc now with windows 10 professional.

I tried this code again and I cant believe how well this code works for my needs. It performs beyond my expectations.

Is there a way I could add items to it?

Like say I need to add a name between the 3rd and 4th line?

or If I need to add a couple of chr(34)s after the qr code for line 2 and before line 3?

I am the only one who uses this computer so I could add the stuff myself into the vba code but am not sure how, since this is using a for next loop.

Background
My company form has 5 items
VIN: (Vehicle Identification Number)
OD: (Milage)
Plate: (License)
Sticker Number: (Certificate Number)
Insert Number: (Certificate Number)

All this data gets entered into a state webpage. Their web page has 11 items. it is so much easier and faster to use a barcode reader to enter the data into the webpage, rather than me type it in or using the mouse

But their web page isnt in the order of our form, and I might need to press the tab key three times after one of there items to get to the field for my next item.

Thanks for any help you could provide. I really am thankful.

gmayor · #6 04-28-2021, 08:35 PM

Did you retain the QR code in the original macro, or did you change it to a CODE39? If you want the CODE39 then you need to change the line

Code:

oRng.Fields.Add oPara, 99, Chr(34) & sNum & Chr(34) & Chr(32) & "QR" & " \t", False

to

Code:

oRng.Fields.Add oPara, 99, Chr(34) & Chr(42) & sNum & Chr(42) & Chr(34) & Chr(32) & "CODE39" & " \t", False

As for the rest, I don't understand what you mean. You can edit the calendar body in any way you wish using VBA. It is essentially a Word document.

The body you suggested looks like:

VIN: (Vehicle Identification Number)
OD: (Mileage)
Plate: (Licence)
Sticker Number: (Certificate Number)
Insert Number: (Certificate Number)

What do you want the finished body to look like?

komobu · #7 04-29-2021, 06:39 AM

I am using the QR Code and not code 39. Qr code works much better and quicker.

Hear is a screen capture of my calendar item:https://www.msofficeforums.com/attac...1&d=1619701970

Here is what the webpage looks like that I have to type in the data
https://www.msofficeforums.com/attac...1&d=1619701970

If I select the Inspector field(1) and type in the inspector, when i hit the tab key, it will take me to 2 then 3 ,4,5 etc.

So, my form line 2 actually enters into webpage 7
My form line 3 enters into webpage 11
My form line 5 enters into webpage 6
My form line 6 enters into webpage 8
and as for the vin, they want just the last four digits of it to be entered in to webpage 12

So now I want to add QRs for the other items on the Webpage form, being

Webpage1
Webpage2
webpage3
webpage4
Webpage5
Webpage9
Webpage10 (Checkbox)

When I run the qr macro, it looks like this
https://www.msofficeforums.com/attac...1&d=1619701970

So I would have to scroll down the form to get to the other fields.

I am hoping to get it to put 4 qrs per line so it ends up looking like this
https://www.msofficeforums.com/attac...1&d=1619701970

What I was wondering about is creating 12 variables. Each variable would have the written text followed by the QRcode.

Then I could simply put each variable plus chr(32) or chr(34) where needed.

I could also just add my items for webpage1, 2,3,4,5,9, and 10 into the code before the for next loop because they really wont change.

Hope this clears it all up

Thanks again for all your help

gmayor · #8 04-29-2021, 11:33 PM

The principles would be similar, but given the proposed layout, I suggest using a table.
The bigger problem is the missing values, so unless you have a better idea, you could define them as variables as shown below. The following works with your example and the VIN number is the last four digits

Code:

Option Explicit

Sub AddBarCode()
'Graham Mayor - https://www.gmayor.com - Last updated - 30 Apr 2021
Dim olItem As AppointmentItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim oPara As Object
Dim oParRng As Object
Dim oTable As Object
Dim oCell As Object
Dim lngCell As Long
Dim sEmail As String
Dim sType As String
Dim sInspector As String
Dim sPin As String
Dim sDate As String
Dim sUnlicensed As String
Dim sBar As String

'define the missing values

    sEmail = "someone@somewhere.com"
    sType = "CAR/TRUCK"
    sInspector = "KOMOBU"
    sPin = "1234"
    sDate = Format(Date, "mm/dd/yyyy")
    sUnlicensed = "False"

    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))
        oRng.collapse 1
        Set oTable = oRng.Tables.Add(oRng, 3, 4)
        oRng.Start = oTable.Range.End
        oRng.End = wdDoc.Range.End
        For Each oPara In oRng.Paragraphs
            Set oParRng = oPara.Range
            oParRng.End = oParRng.End - 1
            If InStr(1, oParRng.Text, ":") > 0 Then
                Select Case Trim(UCase(Split(oParRng.Text, ":")(0)))
                    Case "VIN"
                        Set oCell = oTable.Range.cells(12).Range
                        oCell.End = oCell.End - 1
                        oCell.Text = oParRng.Text
                    Case "OD"
                        Set oCell = oTable.Range.cells(7).Range
                        oCell.End = oCell.End - 1
                        oCell.Text = oParRng.Text
                    Case "PLATE"
                        Set oCell = oTable.Range.cells(11).Range
                        oCell.End = oCell.End - 1
                        oCell.Text = oParRng.Text
                    Case "STICKER NUMBER"
                        Set oCell = oTable.Range.cells(6).Range
                        oCell.End = oCell.End - 1
                        oCell.Text = oParRng.Text
                    Case "INSERT NUMBER"
                        Set oCell = oTable.Range.cells(8).Range
                        oCell.End = oCell.End - 1
                        oCell.Text = oParRng.Text
                End Select
            End If
        Next oPara
        Set oCell = oTable.Range.cells(1).Range
        oCell.End = oCell.End - 1
        oCell.Text = "INSPECTOR: " & sInspector
        Set oCell = oTable.Range.cells(2).Range
        oCell.End = oCell.End - 1
        oCell.Text = "PIN: " & sPin
        Set oCell = oTable.Range.cells(3).Range
        oCell.End = oCell.End - 1
        oCell.Text = "EMAIL: " & sEmail
        Set oCell = oTable.Range.cells(4).Range
        oCell.End = oCell.End - 1
        oCell.Text = "CONFIRM EMAIL: " & sEmail
        Set oCell = oTable.Range.cells(5).Range
        oCell.End = oCell.End - 1
        oCell.Text = "VEHICLE TYPE: " & sType
        Set oCell = oTable.Range.cells(9).Range
        oCell.End = oCell.End - 1
        oCell.Text = "DATE: " & sDate
        Set oCell = oTable.Range.cells(10).Range
        oCell.End = oCell.End - 1
        oCell.Text = "ULICENSED: " & sUnlicensed

        For lngCell = 1 To 12
            Set oCell = oTable.Range.cells(lngCell).Range
            oCell.End = oCell.End - 1
            oCell.MoveStartUntil ":"
            oCell.Start = oCell.Start + 2
            If lngCell = 12 Then
                sBar = Right(oCell.Text, 4)
            Else
                sBar = oCell.Text
            End If
            wdDoc.Fields.Add oCell, 99, Chr(34) & sBar & Chr(34) & Chr(32) & "QR" & " \t", False
        Next lngCell
        'oRng.Delete 'Optionally delete the original text
        .Display
    End With
lbl_Exit:
    Exit Sub
End Sub

You can send your appreciation to my web site

komobu · #9 04-30-2021, 07:31 AM

Graham;

This code is awesome! Wish I had your skills.

komobu · #10 05-03-2021, 04:27 AM

This code works great!

Now I am wondering about putting several fields in one qr code.

Instead of having 12 qr codes and scanning each one in, I am wondering about putting all 12 entries in one qr code and seeing if I can enter the page worth of data with one barcode scan instead of 12.

I will have to play with it and see how many fields of data I can add. There has to be a horizontal tab (chr(9)) between the fields. So it would look like:

Dim sTotalQR As String
sTotalQR = sEmail + chr(9) + sType + chr(9) + sInspector +chr(9) +sPin + chr(9) + sDate

Could you explain a couple of lines of code so I can try to grasp what is happening?
What does “Option Explicit” do at the top of the sub?

Usually I use “+” to string fields together. I notice you are using “&” as in
wdDoc.Fields.Add oCell, 99, Chr(34) & sBar & Chr(34) & Chr(32) & "QR" & " \t", False

What code is actually generating the qr? Is it just this part of the line?
& "QR" & " \t", False

So could I add
sTotalQR = sEmail + chr(9) + sType + chr(9) + sInspector +chr(9) +sPin + chr(9) + sDate & “QR” & “ \t”, False
right where the ‘oRng.delete line is (Line 110) is to get a total qr code?

Thanks again for all your help

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Barcode Scanning	Sueade	Excel	1	11-11-2015 04:07 PM
Looping Macro to Change Font, Font Size, and Give Heading 1	WH7262	Word VBA	1	08-26-2014 03:46 PM
MICROSOFT barcode control -changing the barcode image in realtime	artner0112	Excel	1	12-18-2011 09:33 AM
Postnet Barcode	Doc_man	Mail Merge	1	09-29-2010 03:06 AM
barcode add ins ????	quince	Office	2	11-11-2005 12:40 AM