[VBA] How to Output Data Scanned with Pasori RC-S300 to Excel

Background

I wanted to see if I could use the data inside a card using a contactless IC card reader, so I studied how to achieve this.

Install the Driver

First, download the driver from the link below and install the exe file. https://www.sony.co.jp/Products/felica/consumer/support/download/nfcportsoftware.html

Use Windows API

Next, write the code. Please copy and paste the following into Module 1.

'' Declarations for using standard Windows API. Returns a message starting with "ERROR:" if an error occurs,
'' and returns the UID if reading is successful. Operation confirmed only with SONY RC-S380.
'' This code is not practical for Type B cards as they return random values (PUPI).

Public Function readUID() As String
'' Define a Public function named readUID. The return value type is String.

Const SCARD_SCOPE_USER As Integer = 0
'' Declare a constant SCARD_SCOPE_USER and initialize it with 0. This constant is used for smart card scope definition.

Dim ret As LongPtr
Dim pcchReaders As Long
Dim mszReaders As String
Dim readerArray() As String
'' Declare necessary variables.
'' ret: Holds the return value of API functions
'' pcchReaders: Holds the length of the card reader list
'' mszReaders: Holds the card reader list
'' readerArray: String array to hold card reader names

ret = SCardEstablishContext(SCARD_SCOPE_USER, 0, 0, hContext)
'' Establish a new context for the smart card resource manager.

If ret <> 0 Then
    readUID = "ERROR: Initialization failed!"
    Exit Function
End If
'' If initialization is not successful, return an error message and exit the function.

pcchReaders = 256
'' Set the card reader list length to 256.

If readerState.szReader = "" Then
'' Execute the following process if the current reader state is unset.

   ret = SCardListReaders(hContext, vbNullString, mszReaders, pcchReaders)
   '' Get the list of card readers.

   If ret <> 0 Then
       readUID = "ERROR: Card reader not found!"
       Exit Function
   End If
   '' If getting the card reader list fails, return an error message and exit the function.

   mszReaders = String$(pcchReaders, vbNullChar)
   '' Initialize the card reader list.

   ret = SCardListReaders(hContext, vbNullString, mszReaders, pcchReaders)
   '' Get the list of card readers.

   If ret <> 0 Then
       readUID = "ERROR: Card reader not found!"
       Exit Function
   End If
   '' If getting the card reader list fails, return an error message and exit the function.

   readerArray = Split(mszReaders, vbNullChar)
   '' Convert the card reader list to an array.

   readerState.dwCurrentState = 0
   readerState.szReader = readerArray(0)
   '' Set the card reader state.
End If

Dim hCard As LongPtr
Dim activeProtocol As Long
'' Declare variables for card and protocol.

ret = SCardConnectA(hContext, readerState.szReader, SCARD_SHARE_SHARED, SCARD_PROTOCOL_T1, hCard, activeProtocol)
'' Connect to the smart card resource manager.

If ret <> 0 Then
    readUID = "ERROR: Please insert the correct card!"
    Exit Function
End If
'' If connection fails, return an error message and exit the function.

Dim sendBuffer(4) As Byte
Dim recvBuffer(255) As Byte
Dim recvLen As Long
Dim ioSendReq As SCARD_IO_REQUEST
Dim ioRecvReq As SCARD_IO_REQUEST
'' Declare necessary variables. Buffers for sending and receiving, receive length, and send/receive request objects.

ioSendReq.dwProtocol = activeProtocol
ioSendReq.cbPciLength = Len(ioSendReq)
ioRecvReq.dwProtocol = activeProtocol
ioRecvReq.cbPciLength = Len(ioSendReq)
'' Set send/receive request objects.

sendBuffer(0) = &HFF
sendBuffer(1) = &HCA
sendBuffer(2) = &H0
sendBuffer(3) = &H0
sendBuffer(4) = &H0
'' Set data in the send buffer.

recvLen = 255
ret = SCardTransmit(hCard, ioSendReq, sendBuffer(0), 5, ioRecvReq, recvBuffer(0), recvLen)
'' Communicate with the smart card and store the result in the receive buffer.

If ret <> 0 Then
    readUID = "ERROR: ID retrieval error (Transmit:" & Hex(ret) & ")"
    GoTo ExitProc
End If
'' If communication fails, return an error message and jump to the ExitProc label.

If recvBuffer(recvLen - 2) <> &H90 Then
    readUID = "ERROR: ID retrieval error (Read abnormality:" & Hex(recvBuffer(0)) & "," & Hex(recvBuffer(1)) & ")"
    GoTo ExitProc
End If
'' If received data is not normal, return an error message and jump to the ExitProc label.

ExitProc:
'' ExitProc label.

ret = SCardDisconnect(hCard, SCARD_LEAVE_CARD)
'' Disconnect from the smart card resource manager.

If ret <> 0 Then
    MsgBox ("ERROR: Disconnect error " + Hex(ret))
    Exit Function
End If
'' If disconnection fails, display an error message and exit the function.

Dim cardData As String
Dim i As Long
cardData = ""
For i = 0 To 8
    If Chr(recvBuffer(i)) <> Space(1) Then
        cardData = cardData & Hex(recvBuffer(i))
    End If
Next
'' Retrieve data from the receive buffer and convert it to a string.

readUID = cardData
'' Set the data as the return value of the function.

End Function
'' End of function.

Code Explanation

• API Declarations: These declare API calls to the Windows Winscard.dll library. This allows you to use functions such as connecting to/disconnecting from the card reader and retrieving card information.
• readUID Function: This is the main function containing the actual card reading logic. It handles connecting to the card reader, sending/receiving card information, checking for errors, and outputting the UID read from the card.
• Error Handling: It checks for errors at each step and outputs error messages.

Create an Execution Macro

Next, create Module 2 and copy and paste the following code.

Public Sub ExecuteReadUID()
    Dim result As String
    result = readUID()
    MsgBox result
End Sub

Summary

Finally, create a button from “Insert” in Excel, assign the macro above to it, hold the IC card over the terminal, and press the button. The number inside the card should be output. I hope this helps.