Public Function UPCE2UPCA(ByVal UPCE As String) As String
    '
    ' Convert UPC-E to UPC-A format
    '
    ' Written by Glenn J. Schworak (www.schworak.com)
    '
    Dim ValidDigits As String
    Dim Mfg As String
    Dim Prod As String
    
    If Len(UPCE) <> 8 Or (Left(UPCE, 1) <> "0" And Left(UPCE, 1) <> "1") Then
        '
        ' Return INVALID instead of a UPC-A code
        '
        UPCE2UPCA = "INVALID"
    Else
        '
        ' Convert the UPC-E to UPC-A
        '
        ValidDigits = Mid(UPCE, 2, 6)
        Select Case Right(ValidDigits, 1)
            Case "0"
                Mfg = Left(ValidDigits, 2) & Right(ValidDigits, 1) & "00"
                Prod = "00" & Mid(ValidDigits, 3, 3)
            Case "1"
                Mfg = Left(ValidDigits, 2) & Right(ValidDigits, 1) & "00"
                Prod = "00" & Mid(ValidDigits, 3, 3)
            Case "2"
                Mfg = Left(ValidDigits, 2) & Right(ValidDigits, 1) & "00"
                Prod = "00" & Mid(ValidDigits, 3, 3)
            Case "3"
                Mfg = Left(ValidDigits, 3) & "00"
                Prod = "000" & Mid(ValidDigits, 4, 2)
            Case "4"
                Mfg = Left(ValidDigits, 4) & "0"
                Prod = "0000" & Mid(ValidDigits, 5, 1)
            Case Else
                Mfg = Left(ValidDigits, 5)
                Prod = "0000" & Mid(ValidDigits, 6, 1)
        End Select
        '
        ' Return the 12 digit UPC-A code
        '
        UPCE2UPCA = Left(UPCE, 1) & Mfg & Prod & Right(UPCE, 1)
    End If
End Function

Close

Search

Close

Share

Close

Dialog