Code
Function CheckCard(CCNumber As String) As Boolean
Dim Counter As Integer, TmpInt As Integer
Dim Answer As Integer
Counter = 1
TmpInt = 0
While Counter <= Len(CCNumber)
If IsEven(Len(CCNumber)) Then
TmpInt = Val(Mid$(CCNumber, Counter, 1))
If Not IsEven(Counter) Then
TmpInt = TmpInt * 2
If TmpInt > 9 Then TmpInt = TmpInt - 9
End If
Answer = Answer + TmpInt
'Debug.Print Counter, TmpInt, Answer
Counter = Counter + 1
Else
TmpInt = Val(Mid$(CCNumber, Counter, 1))
If IsEven(Counter) Then
TmpInt = TmpInt * 2
If TmpInt > 9 Then TmpInt = TmpInt - 9
End If
Answer = Answer + TmpInt
'Debug.Print Counter, TmpInt, Answer
Counter = Counter + 1
End If
Wend
Answer = Answer Mod 10
If Answer = 0 Then CheckCard = True
End Function
Function IsEven(lngNumber As Long) As Boolean
If lngNumber Mod 2 = 0 Then
IsEven = True
Else
IsEven = False
End If
End FunctionPublic Function CreditCardType(ByVal CardNo As String) As String
'*CARD TYPES *PREFIX *WIDTH
'American Express 34, 37 15
'Diners Club 300 to 305, 36 14
'Carte Blanche 38 14
'Discover 6011 16
'EnRoute 2014, 2149 15
'JCB 3 16
'JCB 2131, 1800 15
'Master Card 51 to 55 16
'Visa 4 13, 16
'Just in case nothing is found
CreditCardType = "Unknown"
'Remove all spaces and dashes from the passed string
CardNo = Replace(Replace(CardNo, " ", ""), "-", "")
'Check that the minimum length of the string isn't less
'than fourteen characters and -is- numeric
If Len(CardNo) < 14 Or Not IsNumeric(CardNo) Then Exit Function
'Check the first two digits first
Select Case CInt(Left(CardNo, 2))
Case 34, 37
CreditCardType = "American Express"
Case 36
CreditCardType = "Diners Club"
Case 38
CreditCardType = "Carte Blanche"
Case 51 To 55
CreditCardType = "Master Card"
Case Else
'None of the above - so check the
'first four digits collectively
Select Case CInt(Left(CardNo, 4))
Case 2014, 2149
CreditCardType = "EnRoute"
Case 2131, 1800
CreditCardType = "JCB"
Case 6011
CreditCardType = "Discover"
Case Else
'None of the above - so check the
'first three digits collectively
Select Case CInt(Left(CardNo, 3))
Case 300 To 305
CreditCardType = "American Diners Club"
Case Else
'None of the above -
'so simply check the first digit
Select Case CInt(Left(CardNo, 1))
Case 3
CreditCardType = "JCB"
Case 4
CreditCardType = "Visa"
End Select
End Select
End Select
End Select
End Function
