MENU
知の森へ
  1. ホーム
  2. VBA樹林
  3. パソリPC-S300で読み取ったデータをExcelに出力したい【VBA】

パソリPC-S300で読み取ったデータをExcelに出力したい【VBA】

VBA樹林
目次

経緯

非接触ICカードリーダーを使って、そのカードの中の数値でいろいろできないか試したくて、

今回勉強しました。

ドライバーをインストール

はじめに以下のドライバーをダウンロードして、
https://www.sony.co.jp/Products/felica/consumer/support/download/nfcportsoftware.html

exeファイルをインストールしてください。

Windows APIを使う

次に、コードを書きます。モジュール1にコピペしてください。

'' Windows標準APIを使用するための宣言。エラーが発生した場合は"ERROR:"で始まるメッセージを返し、
'' 正常に読み込みができた場合はUIDを返す。カードリーダはSONY RC-S380のみが動作確認済み。
'' TypeBのカードは乱数値(PUPI)を返すため、このコードでは実用的ではない。

Public Function readUID() As String
'' readUIDという名前のPublic関数を定義。戻り値の型はString。

Const SCARD_SCOPE_USER As Integer = 0
'' SCARD_SCOPE_USERという定数を宣言し、0で初期化。この定数はスマートカードのスコープ定義に使用される。

Dim ret As LongPtr
Dim pcchReaders As Long
Dim mszReaders As String
Dim readerArray() As String
'' 必要な変数を宣言。
'' ret: API関数の戻り値を保持
'' pcchReaders: カードリーダのリスト長を保持
'' mszReaders: カードリーダのリストを保持
'' readerArray: カードリーダの名前を保持する文字列配列

ret = SCardEstablishContext(SCARD_SCOPE_USER, 0, 0, hContext)
'' スマートカードリソースマネージャの新しいコンテキストを確立。

If ret <> 0 Then
    readUID = "ERROR:初期化処理に失敗しました！"
    Exit Function
End If
'' 初期化が正常に行われなかった場合、エラーメッセージを返して関数を終了。

pcchReaders = 256
'' カードリーダのリスト長を256に設定。

If readerState.szReader = "" Then
'' 現在のリーダーの状態が未設定の場合、以下の処理を実行。

   ret = SCardListReaders(hContext, vbNullString, mszReaders, pcchReaders)
   '' カードリーダのリストを取得。

   If ret <> 0 Then
       readUID = "ERROR:カードリーダが見つかりません！"
       Exit Function
   End If
   '' カードリーダのリスト取得が失敗した場合、エラーメッセージを返して関数を終了。

   mszReaders = String$(pcchReaders, vbNullChar)
   '' カードリーダのリストを初期化。

   ret = SCardListReaders(hContext, vbNullString, mszReaders, pcchReaders)
   '' カードリーダのリストを取得。

   If ret <> 0 Then
       readUID = "ERROR:カードリーダが見つかりません！"
       Exit Function
   End If
   '' カードリーダのリスト取得が失敗した場合、エラーメッセージを返して関数を終了。

   readerArray = Split(mszReaders, vbNullChar)
   '' カードリーダのリストを配列に変換。

   readerState.dwCurrentState = 0
   readerState.szReader = readerArray(0)
   '' カードリーダの状態を設定。
End If

Dim hCard As LongPtr
Dim activeProtocol As Long
'' カードとプロトコルの変数を宣言。

ret = SCardConnectA(hContext, readerState.szReader, SCARD_SHARE_SHARED, SCARD_PROTOCOL_T1, hCard, activeProtocol)
'' スマートカードリソースマネージャに接続。

If ret <> 0 Then
    readUID = "ERROR:正しいカードをセットしてください！"
    Exit Function
End If
'' 接続が失敗した場合、エラーメッセージを返して関数を終了。

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
'' 必要な変数を宣言。送信と受信用のバッファ、受信長、送受信リクエストオブジェクト。

ioSendReq.dwProtocol = activeProtocol
ioSendReq.cbPciLength = Len(ioSendReq)
ioRecvReq.dwProtocol = activeProtocol
ioRecvReq.cbPciLength = Len(ioSendReq)
'' 送受信リクエストオブジェクトを設定。

sendBuffer(0) = &HFF
sendBuffer(1) = &HCA
sendBuffer(2) = &H0
sendBuffer(3) = &H0
sendBuffer(4) = &H0
'' 送信バッファにデータを設定。

recvLen = 255
ret = SCardTransmit(hCard, ioSendReq, sendBuffer(0), 5, ioRecvReq, recvBuffer(0), recvLen)
'' スマートカードとの通信を行い、結果を受信バッファに格納。

If ret <> 0 Then
    readUID = "ERROR:ID取得エラー(Transmit:" & Hex(ret) & ")"
    GoTo ExitProc
End If
'' 通信が失敗した場合、エラーメッセージを返してExitProcラベルへジャンプ。

If recvBuffer(recvLen - 2) <> &H90 Then
    readUID = "ERROR:ID取得エラー（読込異常：" & Hex(recvBuffer(0)) & "," & Hex(recvBuffer(1)) & ")"
    GoTo ExitProc
End If
'' 受信データが正常でない場合、エラーメッセージを返してExitProcラベルへジャンプ。

ExitProc:
'' ExitProcラベル。

ret = SCardDisconnect(hCard, SCARD_LEAVE_CARD)
'' スマートカードリソースマネージャから切断。

If ret <> 0 Then
    MsgBox ("ERROR:切断エラー " + Hex(ret))
    Exit Function
End If
'' 切断が失敗した場合、エラーメッセージを表示して関数を終了。

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
'' 受信バッファからデータを取得し、文字列に変換。

readUID = cardData
'' 関数の戻り値にデータを設定。

End Function
'' 関数の終わり。

これは、

  1. API宣言: これらはWindowsのWinscard.dllライブラリに対するAPI呼び出しを宣言しています。これにより、カードリーダーへの接続、切断、カード情報の取得などの機能を利用することができます。
  2. readUID関数: これは実際のカード読み取りロジックを含む主要な関数です。ここでは、カードリーダーへの接続、カード情報の送受信、エラーチェック、そしてカードから読み取ったUIDの出力を行っています。
  3. エラーハンドリング: 各ステップでエラーチェックを行い、エラーメッセージを出力しています。

ということをしています。

実行マクロを作る

次にモジュール2を作って、以下のコードをコピペしてください。

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

という感じです。

あとは、Excelの”挿入”からボタンとか作って、↑のコードをマクロ登録して、端末にICカードをかざして、ボタンを押すとカードの中の数値が出力されると思います。

参考になれば、幸いです。

ここまで読んでいただきありがとうございました。

【AI×就労支援】Neuro Dive（ニューロダイブ）で先端ITを学び、スペシャリストとしての就職を目指しませんか？

最後に宣伝をさせてください。

AIやデータサイエンス、RPAといった分野に興味はあるけれど、
「どうやって学べばよいか分からない」「就職につなげる方法が見つからない」とお悩みの方へ。

Neuro Dive（ニューロダイブ）は、
パーソルダイバース株式会社が運営する日本初の「先端IT特化型」就労移行支援サービスです。

障害のある方を対象に、AI・機械学習・データサイエンスなど、今まさに社会で求められている高度なスキルを身につけ、IT系企業での就職を現実のものとするサポートを行っています。

Neuro Diveが選ばれる理由

  • 就職率80%以上、職場定着率95%以上という実績
  • eラーニングによる柔軟な学習スタイル
  • 実践型カリキュラムで、**「ビジネスで通用するスキル」**が身につく
  • プログラミング未経験から就職を果たした事例も多数

こんな方におすすめです

  • AIやIT技術に興味があり、専門スキルを身につけたい方
  • 独学では限界を感じている方
  • 自分の得意分野（集中力・観察力・論理的思考力）を仕事に活かしたい方
  • 障害を持ちながらも、IT分野でスペシャリストを目指したいと考えている方

Neuro Diveは、18歳から64歳までの一般就労を目指す障害のある方を対象としています。
プログラミングやAIは未経験という方でも、「やってみたい」という気持ちがあれば大丈夫です。

未来を変える一歩は、ここから始まります。
先端ITを学びながら、自分の力を社会で活かすための一歩を踏み出してみませんか？

▶ 詳しくはこちらから AIやデータサイエンスが学べる就労移行支援【Neuro Dive】



VBA樹林
VBA
よかったらシェアしてね！
  • URLをコピーしました！
  • URLをコピーしました！

この記事を書いた人

morishuheiのアバター morishuhei

私が勉強したこと、実践したこと、してることを書いているブログです。
主に資産運用について書いていたのですが、
最近はプログラミングに興味があるので、今はそればっかりです。

関連記事

目次