Create a new module and paste this code into it. Call the module basCCFormat.
If you have any questions, email us at help@codeoftheweek.com
'----------------------------------------------------------------------
'
' Module Name: basCCFormat
' Written By: C&D Programming Corp.
' Create Date: 1/2000
' Copyright: Copyright 2000 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'
'----------------------------------------------------------------------
Option Explicit
Private Const CARD_DELIM = "-"
Private Function StripAllButNumbers(sData As String) As String
Dim sTemp As String
Dim x As Long
Dim sCh As String
' scan through the string and add all the numeric characters to
' temporary string.
sTemp = ""
For x = 1 To Len(sData)
sCh = Mid$(sData, x, 1)
If sCh >= "0" And sCh <= "9" Then
sTemp = sTemp & sCh
End If
Next
StripAllButNumbers = sTemp
End Function
Public Function FormatCreditCardNumber(sCardNumber As String, Optional bSecure As Boolean = False) As String
Dim sTempCard As String
Dim sFormattedCard As String
sFormattedCard = "" ' let's assume the number is invalid for now.
' first make sure we are dealing with a clean credit card number, no spaces
' dashes or anything else
sTempCard = StripAllButNumbers(sCardNumber)
' american express is 15 digits; visa,mastercard,novus is 16 digits
' if anyone has any other cards let us know and we can add them here
If Len(sTempCard) = 15 Or Len(sTempCard) = 16 Then
' card number is the right length so let's format it appropriately.
Select Case Left(sTempCard, 1)
Case "3" ' 3=amex
If Len(sTempCard) <> 15 Then
Err.Raise 5, "FormatCreditCardNumber", "An American Express card number must be 15 characters long"
End If
If bSecure Then
sFormattedCard = "XXXX" & CARD_DELIM & "XXXXXX" & CARD_DELIM & _
Right(sTempCard, 5)
Else
sFormattedCard = Left(sTempCard, 4) & _
CARD_DELIM & Mid(sTempCard, 5, 6) & _
CARD_DELIM & Right(sTempCard, 5)
End If
Case "4", "5", "6" ' 5=mc,4=visa,6=discover
If Len(sTempCard) <> 16 Then
Err.Raise 5, "FormatCreditCardNumber", "A Visa, MasterCard or Novus card number must be 16 characters long"
End If
If bSecure Then
sFormattedCard = "XXXX" & CARD_DELIM & "XXXX" & CARD_DELIM & _
"XXXX" & CARD_DELIM & Right(sTempCard, 4)
Else
sFormattedCard = Left(sTempCard, 4) & _
CARD_DELIM & Mid(sTempCard, 5, 4) & _
CARD_DELIM & Mid(sTempCard, 9, 4) & _
CARD_DELIM & Right(sTempCard, 4)
End If
Case Else
' not sure exactly what to do if the card does not match one of the above
' types. Feel free to adjust as desired.
If bSecure Then
sFormattedCard = String(Len(sTempCard) - 4, "X") & _
Right(sTempCard, 4)
Else
sFormattedCard = sTempCard
End If
End Select
Else
Err.Raise 5, "FormatCreditCardNumber", "The card number you supplied is not valid. It must be either 15 or 16 characters long."
End If
FormatCreditCardNumber = sFormattedCard
End Function