Function isVIN(VIN As String) As Boolean
' 检查车架号VIN是否符合标准
' 参数：
' VIN：需要检查的车架号字符串
' 返回值:
' Boolean: 正确返回True，错误返回False
If TypeName(VIN) <> "String" Then ' 如果不是文本，退出检查
isVIN = False
Exit Function
End If
If Len(Trim(VIN)) <> 17 Then ' 如果没有17位，退出检查
isVIN = False
Exit Function
End If
VIN = UCase(VIN)
Dim RE As Object
Set RE = CreateObject("VBScript.RegExp")
RE.Pattern = "^[A-HJ-NPR-Z\d]{8}[X\d][A-HJ-NPR-Z\d]{3}\d{5}$"
If Not RE.Test(VIN) Then ' 如果不符合正则要求，退出检查
isVIN = False
Exit Function
End If
Dim cOT As Object
Set cOT = CreateObject("Scripting.Dictionary")
cOT.Add "0", 0
cOT.Add "1", 1
cOT.Add "2", 2
cOT.Add "3", 3
cOT.Add "4", 4
cOT.Add "5", 5
cOT.Add "6", 6
cOT.Add "7", 7
cOT.Add "8", 8
cOT.Add "9", 9
cOT.Add "A", 1
cOT.Add "B", 2
cOT.Add "C", 3
cOT.Add "D", 4
cOT.Add "E", 5
cOT.Add "F", 6
cOT.Add "G", 7
cOT.Add "H", 8
cOT.Add "J", 1
cOT.Add "K", 2
cOT.Add "L", 3
cOT.Add "M", 4
cOT.Add "N", 5
cOT.Add "P", 7
cOT.Add "R", 9
cOT.Add "S", 2
cOT.Add "T", 3
cOT.Add "U", 4
cOT.Add "V", 5
cOT.Add "W", 6
cOT.Add "X", 7
cOT.Add "Y", 8
cOT.Add "Z", 9
Dim xWT As Variant
xWT = Array(8, 7, 6, 5, 4, 3, 2, 10, 0, 9, 8, 7, 6, 5, 4, 3, 2)
Dim sum As Long
For i = 1 To 17
sum = sum + cOT(Mid(VIN, i, 1)) * xWT(i - 1)
Next i
Dim cT As Variant
cT = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "X")
isVIN = (cT(sum Mod 11) = Mid(VIN, 9, 1))
End Function
