VBA Code สำหรับสร้างรหัสพร้อมเพย์จากหมายเลขพร้อมเพย์ เพื่อใช้กับ QR Code

PromptPayQRmodule.bas

Function PromptPayQR(PromptPayID As String, Optional BahtValue As Double = 0#, Optional OneTime As Boolean = False)
 'PromptPay QR code Generator By Pongsathorn Sraouthai BE 2566 (V 2.0)
 'This will convert text to encode to QR code for use to generate QR 2D Barcode
 'Using PROMPTPAYQR(PromptPayID,BahtValue,OneTime)
 'PromptPayID =  PromptPay ID (Mobile Phone number (10 digit) or Thai ID number (13 digit) or E-Wallet Number (15 digit))
 'BahtValue = amount of money
 'Onetime = True or False (Default is False)
 'More information https://www.blognone.com/node/95133

Dim CRC16Calc
Dim PPLoad As String
Dim LenBaht
Dim PPot
Dim PNum

'ID
Dim ID_PAYLOAD_FORMAT: ID_PAYLOAD_FORMAT = "00"
Dim ID_POI_METHOD: ID_POI_METHOD = "01"
Dim ID_MERCHANT_INFORMATION_BOT: ID_MERCHANT_INFORMATION_BOT = "29"
Dim ID_TRANSACTION_CURRENCY: ID_TRANSACTION_CURRENCY = "53"
Dim ID_TRANSACTION_AMOUNT: ID_TRANSACTION_AMOUNT = "54"
Dim ID_COUNTRY_CODE: ID_COUNTRY_CODE = "58"
Dim ID_CRC: ID_CRC = "63"
'Data
Dim PAYLOAD_FORMAT_EMV_QRCPS_MERCHANT_PRESENTED_MODE: PAYLOAD_FORMAT_EMV_QRCPS_MERCHANT_PRESENTED_MODE = "01"
Dim POI_METHOD_STATIC: POI_METHOD_STATIC = "11"
Dim POI_METHOD_DYNAMIC: POI_METHOD_DYNAMIC = "12"
Dim MERCHANT_INFORMATION_TEMPLATE_ID_GUID: MERCHANT_INFORMATION_TEMPLATE_ID_GUID = "00"
Dim BOT_ID_MERCHANT_PHONE_NUMBER: BOT_ID_MERCHANT_PHONE_NUMBER = "01"
Dim BOT_ID_MERCHANT_TAX_ID: BOT_ID_MERCHANT_TAX_ID = "02"
Dim BOT_ID_MERCHANT_EWALLET_ID: BOT_ID_MERCHANT_EWALLET_ID = "03"
Dim GUID_PROMPTPAY: GUID_PROMPTPAY = "A000000677010111"
Dim TRANSACTION_CURRENCY_THB: TRANSACTION_CURRENCY_THB = "764"
Dim COUNTRY_CODE_TH: COUNTRY_CODE_TH = "TH"

Select Case OneTime
    Case vbTrue
        PPot = POI_METHOD_DYNAMIC
    Case vbFalse
        PPot = POI_METHOD_STATIC
End Select

'Field format: Field + Length of field data + data)
'eg. field 00, length 2 digit and data 01 should be 00/02/01 -> 000201

'Head
        'F 00
        PPLoad = ID_PAYLOAD_FORMAT & Format(Len(PAYLOAD_FORMAT_EMV_QRCPS_MERCHANT_PRESENTED_MODE), "00") & PAYLOAD_FORMAT_EMV_QRCPS_MERCHANT_PRESENTED_MODE
        'F 01
        PPLoad = PPLoad & ID_POI_METHOD & Format(Len(PPot), "00") & PPot
'Body
Select Case Len(PromptPayID)
    Case Is = 10
        'F 29
        PNum = "0066" & Right(PromptPayID, 9)
        PPLoad = PPLoad & ID_MERCHANT_INFORMATION_BOT & Len(MERCHANT_INFORMATION_TEMPLATE_ID_GUID & Len(GUID_PROMPTPAY) & GUID_PROMPTPAY & BOT_ID_MERCHANT_PHONE_NUMBER & Len(PNum) & PNum) & MERCHANT_INFORMATION_TEMPLATE_ID_GUID & Len(GUID_PROMPTPAY) & GUID_PROMPTPAY & BOT_ID_MERCHANT_PHONE_NUMBER & Len(PNum) & PNum
    Case Is = 13
        'F 29
        PPLoad = PPLoad & ID_MERCHANT_INFORMATION_BOT & Len(MERCHANT_INFORMATION_TEMPLATE_ID_GUID & Len(GUID_PROMPTPAY) & GUID_PROMPTPAY & BOT_ID_MERCHANT_TAX_ID & Len(PromptPayID) & PromptPayID) & MERCHANT_INFORMATION_TEMPLATE_ID_GUID & Len(GUID_PROMPTPAY) & GUID_PROMPTPAY & BOT_ID_MERCHANT_TAX_ID & Len(PromptPayID) & PromptPayID
    Case Is = 15
        'F 29
        PPLoad = PPLoad & ID_MERCHANT_INFORMATION_BOT & Len(MERCHANT_INFORMATION_TEMPLATE_ID_GUID & Len(GUID_PROMPTPAY) & GUID_PROMPTPAY & BOT_ID_MERCHANT_EWALLET_ID & Len(PromptPayID) & PromptPayID) & MERCHANT_INFORMATION_TEMPLATE_ID_GUID & Len(GUID_PROMPTPAY) & GUID_PROMPTPAY & BOT_ID_MERCHANT_EWALLET_ID & Len(PromptPayID) & PromptPayID
    Case Else
        PPLoad = "N/A"
End Select

If PPLoad = "N/A" Then
    PromptPayQR = "#N/A"
    Exit Function
End If

'Foot
        'F 53
        PPLoad = PPLoad & ID_TRANSACTION_CURRENCY & Format(Len(TRANSACTION_CURRENCY_THB), "00") & TRANSACTION_CURRENCY_THB

If BahtValue > 0 Then
        'F 54
        LenBaht = Format(Len(Format(BahtValue, "0.00")), "00")
        PPLoad = PPLoad & ID_TRANSACTION_AMOUNT & LenBaht & Format(BahtValue, "0.00")
End If
        'F 58
        PPLoad = PPLoad & ID_COUNTRY_CODE & Format(Len(COUNTRY_CODE_TH), "00") & COUNTRY_CODE_TH
        'F 63
        PPLoad = PPLoad & ID_CRC & "04"
        'CRC Calc
        CRC16Calc = GetCRC(PPLoad)
        
        PromptPayQR = PPLoad & CRC16Calc
End Function