VIN Encoder

[spinktec]

I'm successfully using the code below to decode Vehicle Identification Numbers (VINs); but I'm looking for a VIN encoder module. Anyone?

Public Function isVIN(strVIN As String) As String
 Dim I As Integer
 Dim intCount As Integer
 Dim intCount2 As Integer
 Dim aModelYears() As Variant
 Dim aWeights() As Variant
 Dim aCharacters() As Variant
 Dim aCharacterValues() As Variant
 Dim aCheckDigits() As Variant
 Dim aVIN_Array(0 To 15) As Variant
 Dim intTotal As Integer
 Dim intRemainder As Integer
 Dim Ftruck As String
 
isVIN = ""
' Check VIN lenth
If Not Len(strVIN) = 17 Then
  'MsgBox "ERROR - VIN lenth must be 17 characters long." & Chr(13) & "You only entered " & Len(strVIN) & " characters."
  isVIN = "Bad - only " & Len(strVIN) & " characters."
  Exit Function
End If
'make VIN all caps
strVIN = UCase(strVIN)
' model years 1980 - 2000
aModelYears = Array("A", "B", "C", "D", "E", "F", "G", "H", "J", "K", "L", "M", "N", "P", "R", "S", "T", "V", "W", "X", "Y")
' weights for multiplyer
aWeights = Array("8", "7", "6", "5", "4", "3", "2", "10", "9", "8", "7", "6", "5", "4", "3", "2")
'characters
aCharacters = Array("A", "B", "C", "D", "E", "F", "G", "H", "J", "K", "L", "M", "N", "P", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9")
'// character values
aCharacterValues = Array("1", "2", "3", "4", "5", "6", "7", "8", "1", "2", "3", "4", "5", "7", "9", "2", "3", "4", "5", "6", "7", "8", "9", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9")
' check digit 0 - 9 and 10 = X
aCheckDigits = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "X")
'// push each character of the vin into an array removing the 9th character (check digit)
'MsgBox "Your VIN's check digit is " & Mid(strVIN, 9, 1)
For intCount = 0 To 16
  If intCount = 1 And Mid(strVIN, intCount + 1, 1) = "S" Then
        'MsgBox "This is a fire truck vin"
        Ftruck = "Fire Truck"
  End If
  If intCount < 8 Then
    aVIN_Array(intCount) = Mid(strVIN, intCount + 1, 1)
  ElseIf intCount > 8 Then
    aVIN_Array(intCount - 1) = Mid(strVIN, intCount + 1, 1)
  End If
Next intCount
'replace with char values
For intCount = 0 To 15
  For intCount2 = 0 To UBound(aCharacters)
    If aVIN_Array(intCount) = aCharacters(intCount2) Then
      aVIN_Array(intCount) = aCharacterValues(intCount2)
    End If
  Next intCount2
Next intCount
'For I = 0 To UBound(aVIN_Array)
'  Debug.Print aVIN_Array(I)
'Next I
'// preform the math
For intCount = 0 To 15
  intTotal = intTotal + aWeights(intCount) * aVIN_Array(intCount)
Next intCount
'debug.print intTotal
intRemainder = intTotal Mod 11
'Debug.Print intRemainder
  If Not Mid(strVIN, 9, 1) = aCheckDigits(intRemainder) Then
    'MsgBox "ERROR - Check digit does not compute. Recheck your VIN number." _
     '     & " Computed check digit:" & aCheckDigits(intRemainder) _
     '     & " Your check digit: " & Mid(strVIN, 9, 1)
     isVIN = "Bad " & Ftruck
  Else
    'MsgBox "Computed check digit: " & aCheckDigits(intRemainder) _
    '       & " VIN number seems to be valid."
    isVIN = "Good " & Ftruck
  End If
End Function