Help converting existing VB code to VBA please

[petrosky]

Hi,

I found this code on the net when looking for a way for one of our departments to verify whether a credit card number given over the phone is a real CC number.

This is to save them having to ring customers back when incorrect data has been given....and yes, they do read the numbers back to customers


function checkcc(ccnumber,cctype)

'checks credit card number for checksum,length and type
'ccnumber= credit card number (all useless characters are
' being removed before check, we hope)
'
'cctype:
' "V" VISA
' "M" Mastercard/Eurocard
' "A" American Express
' "C" Diners Club / Carte Blanche
' "D" Discover
' "E" enRoute
' "J" JCB
' this routine doe NOT handle 'SWITCH' (UK+) credit cards
'returns: checkcc=0 (Bit0) : card valid
' checkcc=1 (Bit1) : wrong type
' checkcc=2 (Bit2) : wrong length
' checkcc=4 (Bit3) : wrong checksum (MOD10-Test)
' checkcc=8 (Bit4) : cardtype unknown
'
ctype=ucase(cctype)

select case ctype
case "V"
cclength="13;16"
ccprefix="4"
case "M"
cclength="16"
ccprefix="51;52;53;54;55"
case "A"
cclength="15"
ccprefix="34;37"
case "C"
cclength="14"
ccprefix="300;301;302;303;304;305;36;38"
case "D"
cclength="16"
ccprefix="6011"
case "E"
cclength="15"
ccprefix="2014;2149"
case "J"
cclength="15;16"
ccprefix="3;2131;1800"
case else
cclength="13;14;15;16"
ccprefix="1;2;3;4;5;6"
end select
prefixes=split(ccprefix,";",-1)
lengths=split(cclength,";",-1)
number=trimtodigits(ccnumber)
prefixvalid=false
lengthvalid=false
for each prefix in prefixes
if instr(number,prefix)=1 then
prefixvalid=true
end if
next
for each length in lengths
if cstr(len(number))=length then
lengthvalid=true
end if
next
result=0
if not prefixvalid then
result=result+1
end if
if not lengthvalid then
result=result+2
end if
qsum=0
for x=1 to len(number)
ch=mid(number,len(number)-x+1,1)
'response.write ch
if x mod 2=0 then
sum=2*cint(ch)
qsum=qsum+(sum mod 10)
if sum>9 then
qsum=qsum+1
end if
else
qsum=qsum+cint(ch)
end if
next
'response.write qsum
if qsum mod 10<>0 then
result=result+4
end if
if cclength=&quot;&quot; then
result=result+8
end if
checkcc=result
end function


CODE ENDS:
The problem I have is firstly the SPLIT function. Is there an equivalent Access function?
If you would prefer to see the code in it's original context. Please go here...

http://www.atretailinfo.com/mod-10.asp

I would appreciate anyone pointing me in the right direction with this one.

Regards,

Peter

PS. Sorry the code is so long.
Remember- It's nice to be important,
but it's important to be nice

 

[vbajock]

There is an article on this at

http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_10205972.html

Bottom of the page there is what looks like a function you can modify called &quot;ParseString&quot; that supposedly replaces this function.

Are you using Access 2000? Split is available to me as a native function. I don't know what libraries you are referencing or what library the Split function is contained in, but you might try updating your Access 2000 to SP2. I am also referencing ADO 2.1 in most of my Access apps, along with the Access 9.0 object libraries.
Kirk

 

[petrosky]

Hi,

Many thanks for the link!
I will look into ParseString() and get back to you when I solve it.

BTW, using Access 97 here.

Regards,

Peter Remember- It's nice to be important,
but it's important to be nice

 

[petrosky]

Hi,

If anyone is interested here is the code I found which seems to work.

Function CardOk(CardNum$) As Boolean
'Logic statement by Richard Harris - obtained from Deja News
'Implemented by Chui Tey - obtained from Deja News
'Concatenation and minor correction by Phil Bornemeier
'Modified for Excel by

http://www.finance-analyst.com

Dim tmpCardNum$, OddSum, EvenSum, i, OneLetter$, Digit, CheckSum
'Initialize

tmpCardNum$ = CardNum$
CardNum$ = &quot;&quot;
OddSum = 0
EvenSum = 0
'Reverse order of cardnum drop non-number characters
For i = Len(tmpCardNum$) To 1 Step -1
OneLetter$ = Mid$(tmpCardNum$, i, 1)

If OneLetter$ <= &quot;9&quot; And OneLetter$ >= &quot;0&quot; Then
CardNum$ = CardNum$ + OneLetter$
End If
Next i

'Add numbers in odd positions
For i = 1 To Len(CardNum$) Step 2

OddSum = OddSum + Val(Mid$(CardNum$, i, 1))
Next i

'Double numbers in even positions, add up all digits, accumulate
For i = 2 To Len(CardNum$) Step 2
Digit = Val(Mid$(CardNum$, i, 1))

EvenSum = EvenSum + Digit * 2 + (Digit * 2 >= 10) * 9
Next i

'Add OddSum and EvenSum
CheckSum = OddSum + EvenSum
'Check if CheckSum divisible by 10
If CheckSum Mod 10 = 0 Then
MsgBox &quot;Card seems OK&quot;, vbOKOnly
Else
MsgBox &quot;Card number fails CheckSum, please check the number again&quot;, vbOKOnly

End If
End Function

Regards,

Peter
Remember- It's nice to be important,
but it's important to be nice