Excel VBAでRS232C通信しよう(kernel32を使用)

VBAでRS232C通信しよう プログラミング

Excel VBAでRS232C通信するプログラムを紹介します。

VBAのModuleとSheetにプログラムを記述し、RS232C通信にはkernel32.dllを使います。

現在でもコマンド制御する装置の中にはRS232C通信やGP-IB通信しか対応していないものがあります。今回紹介するサンプルプログラムが、このような装置の制御やメンテナンスの役に立てればと思います。

VBAでRS232C通信するときのイメージ

VBAのプログラムは、Sheetにユーザーインターフェースのプログラムを記述して、ModuleにRS232C通信プログラムを記述します。

具体的な動きとしては、Sheetにボタンを配置してユーザーからの要求を受け取り、ModuleのRS232C関数を使って接続した機器と通信します。

VBAのRS232C通信の全体イメージ

プログラミング

Module1 プログラム

RS通信のプログラムです。これを『Book1ーModule1(コード)』に記述します。
宣言、ポートオープン関数、ポートクローズ関数、送受信関数です。

※コードを分けて掲載してますが、すべてModule1に記述します。

1.宣言

Option Explicit

Public CommError As Long
Public CommStatus As COMSTAT

Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const OPEN_EXISTING = 3

Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" _
                         (ByVal lpFileName As String, _
                         ByVal dwDesiredAccess As Long, _
                         ByVal dwShareMode As Long, _
                         ByVal lpSecurityAttributes As Long, _
                         ByVal dwCreationDisposition As Long, _
                         ByVal dwFlagsAndAttributes As Long, _
                         ByVal hTemplateFile As Long) As Long

Declare PtrSafe Function WriteFile Lib "kernel32" _
                         (ByVal hFile As Long, _
                         lpBuffer As Any, _
                         ByVal nNumberOfBytesToWrite As Long, _
                         lpNumberOfBytesWritten As Long, _
                         ByVal lpOverlapped As Long) As Boolean

Declare PtrSafe Function ReadFile Lib "kernel32" _
                         (ByVal hFile As Long, lpBuffer As Any, _
                         ByVal nNumberOfBytesToRead As Long, _
                         lpNumberOfBytesRead As Long, _
                         ByVal lpOverlapped As Long) As Boolean

Declare PtrSafe Function CloseHandle Lib "kernel32" _
                         (ByVal hObject As Long) As Long

Declare PtrSafe Function FlushFileBuffers Lib "kernel32" _
                         (ByVal hFile As Long) As Long

Declare PtrSafe Function SetCommState Lib "kernel32" _
                         (ByVal hCommDev As Long, _
                         lpDCB As DCB) As Long

Declare PtrSafe Function SetCommTimeouts Lib "kernel32" _
                         (ByVal hFile As Long, _
                         lpCommTimeouts As COMMTIMEOUTS) As Long

Declare PtrSafe Function SetCommMask Lib "kernel32" _
                         (ByVal hFile As Long, _
                         ByVal dwEvtMask As Long) As Long

Declare PtrSafe Function SetupComm Lib "kernel32" _
                         (ByVal hFile As Long, _
                         ByVal dwInQueue As Long, _
                         ByVal dwOutQueue As Long) As Long

Declare PtrSafe Function GetCommState Lib "kernel32" _
                         (ByVal nCid As Long, lpDCB As DCB) As Long

Declare PtrSafe Function ClearCommError Lib "kernel32" _
                         (ByVal hFile As Long, _
                         lpErrors As Long, _
                         lpStat As COMSTAT) As Long

Type DCB
    DCBlength As Long
    BaudRate As Long
    bfModeCTL As Long
    wReserved As Integer
    XonLim As Integer
    XoffLim As Integer
    ByteSize As Byte
    Parity As Byte
    StopBits As Byte
    XonChar As Byte
    XoffChar As Byte
    ErrorChar As Byte
    EofChar As Byte
    EvtChar As Byte
    wReserved1 As Integer
End Type

Type COMMTIMEOUTS
    ReadIntervalTimeout As Long
    ReadTotalTimeoutMultiplier As Long
    ReadTotalTimeoutConstant As Long
    WriteTotalTimeoutMultiplier As Long
    WriteTotalTimeoutConstant As Long
End Type

Type COMSTAT
    bfHold As Long
    cbInQue As Long
    cbOutQue As Long
End Type

2.ポートオープン

※修正(2022.3.31)
CommOpen → portOpen
戻り値をportOpenとするべきところ、CommOpenと間違えていたので修正。

※修正(2022.9.4)
Baud → lngBaud

※修正(2022.11.7)
port → strPort
CreateFileの引数をstrPortとすべきところ、portと間違えていたので修正。

'ポートオープン
Public Function portOpen() As Long
    Dim Tmo As COMMTIMEOUTS
    Dim CommCB As DCB
    Dim strPort As String
    Dim lngBaud As Long
    
    strPort = "\\.\COM1"
    lngBaud = 38400
    
    portOpen = CreateFile(strPort, (GENERIC_READ Or GENERIC_WRITE), _
                                 0&, 0&, OPEN_EXISTING, _
                                 FILE_ATTRIBUTE_NORMAL, 0&)
    
    If portOpen = -1 Then Exit Function
    SetCommMask portOpen, 0&
    SetupComm portOpen, 10000, 1024&
    
    Tmo.ReadIntervalTimeout = 0
    Tmo.ReadTotalTimeoutMultiplier = CLng(40000 / lngBaud + 1)
    Tmo.ReadTotalTimeoutConstant = 1000&
    Tmo.WriteTotalTimeoutMultiplier = CLng(40000 / lngBaud + 1)
    Tmo.WriteTotalTimeoutConstant = 1000&
    
    SetCommTimeouts portOpen, Tmo
    GetCommState portOpen, CommCB
    
    CommCB.DCBlength = LenB(CommCB)
    CommCB.BaudRate = lngBaud
    CommCB.bfModeCTL = &H2055
    CommCB.XoffLim = 64
    CommCB.XonLim = 64
    CommCB.ByteSize = 8
    CommCB.Parity = 0
    CommCB.StopBits = 0
    
    If SetCommState(portOpen, CommCB) = 0 Then GoTo CommOpenErr
    Exit Function
    
CommOpenErr:
    CloseHandle (portOpen)
    portOpen = -2
    
End Function

関数
portOpen() As Long

戻り値
成功:ファイルハンドル / 失敗:マイナスの値

3.ポートクローズ

'ポートクローズ
Public Sub portClose(ByVal hcomm As Long)
    CloseHandle hcomm
End Sub

関数
portClose(ByVal hcomm As Long)

引数
hcomm:ファイルハンドル

4.送受信

'送受信
Public Function wrkRsComm(ByVal hdlComm As Long, _
                                strSend As String, strRet As String) As Long
    Dim bolRet As Boolean
    Dim lngLen As Long
    Dim lngCnt As Long
    Dim strRev As String * 1000
    Dim sttmr As Single
    Dim ctmr As Single
    
    wrkRsComm = 0
    strRet = ""
    
    '送信
    lngLen = Len(strSend)
    bolRet = WriteFile(hdlComm, ByVal strSend, lngLen, lngCnt, 0&)
    
    '送信エラー
    If lngCnt < lngLen Then
        Call ClearCommError(hdlComm, CommError, CommStatus)
        strRet = "ERROR"
        Call portClose(hdlComm)
        Exit Function
    End If
    
    'ウェイト
    sttmr = Timer
    
    '受信
    Do
        ctmr = Timer
        DoEvents
        bolRet = ReadFile(hdlComm, ByVal strRev, 1000, lngCnt, 0)
        
        If lngCnt <> 0 Then
            strRet = strRet & Left$(strRev, lngCnt)
            wrkRsComm = wrkRsComm + lngCnt
            If InStr(strRet, vbCrLf) > 0 Then Exit Do
        End If
        
        'タイムアウト
        If ctmr > sttmr + 2 Then
            strRet = "time out"
            Exit Do
        End If
    Loop
    
End Function

関数
wrkRsComm(ByVal hdlComm As Long, strSend As String, strRet As String) As Long

引数
hdlComm:ファイルハンドル
strSend:送信データ文字列
strRet:返送データ文字列

戻り値
成功:0以外 / 失敗:0

※受信終了の条件は様々なので、接続する機器の仕様を確認してください。

Sheet1 プログラム

ユーザーインターフェースのプログラムです。

コマンドボタン3つを配置します。(CommandButton1CommandButton2CommandeButton3

CommandButton1:ポートオープン
CommandButton2:ポートクローズ
CommandButton3:コマンド送信

3つのセルを使って表示および入力を行います。(C7C9C10

セルC7:ポートオープンの成功/失敗を表示
セルC9:送信するコマンドを入力
セルC10:受信したデータを表示

Excel Sheet にボタンを配置(RS232C通信)

※説明のためにコードを分けて掲載してますが、すべてShee1に記述します。

1.変数の宣言

Option Explicit

'ファイルハンドル
Private fileHandle As Long

2.ポートオープン

'ポートオープン
Private Sub CommandButton1_Click()
    fileHandle = portOpen()
    
    If fileHandle < 0 Then
        Range("C7") = "NG"
    else
        Range("C7") = "OK"
    End If
End Sub

ポートをオープンしてハンドルを取得します。オープンに失敗するとマイナスの値が返送されます。

C7セルに成功/失敗を表示します。

3.ポートクローズ

'ポートクローズ
Private Sub cmdButton2_Click()
    Call portClose(fileHandle)
    Range("C7") = ""
End Sub

ハンドルを渡して、ポートをクローズします。

C7のセルをクリアします。

4.送受信

※修正(2022.3.31)
wrkRsComm(fileHandle, strCmd, vbCrLf, strRev) → wrkRsComm(fileHandle, strCmd, strRev)
不要な第3引数vbCrLfを削除

'コマンド送受信
Private Sub CommandButton3_Click()
    Dim lngRet As Long
    Dim strCmd As String
    Dim strRev As String
    
    strCmd = Range("C9") & vbCrLf
    lngRet = wrkRsComm(fileHandle, strCmd, strRev)

    If lngRet <> 0 Then
        '返送データを表示
        Range("C10") = strRev
    EndIf

End Function

受信が成功したときは、受け取ったデータをC10セルに表示します。失敗のときは何もしません。

Excelのグラフをアニメーションで動かす方法を紹介しています。

(47秒)

動作確認

ポートオープンとポートクローズ、データの送信と受信を確認します。

1.VBAでポートオープンします
2.VBAから接続している機器にコマンドを送信します
3.接続機器はコマンドを受け取り、データを返送します
4.VBAは受信したデータをSheetに表示します
5.VBAからポートをクローズします

Command1をクリックしてポートオープンします。成功すればC7セルに”OK”を表示します。失敗すると”NG”を表示します。

Excel VBA ポートオープン(RS232C通信)

Command3をクリックして接続している機器にコマンドを送信します。
C9のセルに接続した機器のコマンド(設定したい内容や読み込みたいデータの要求など)を記述します。

Excel VBA コマンド送信(RS232C通信)

接続した機器からデータを受信します。受信したデータをC10セルに表示します。
CommandButton2をクリックしてポートクローズします。

Excel VBA データ受信とポートクローズ(RS232C通信)

以上で動作確認終了です。

まとめ

Excel VBAでRS232C通信するプログラムを紹介しました。

測定器などはモデルチェンジの間隔が長いものがあり、いまだにRS232C通信による制御の製品がありますので、今回のExcelでの制御が参考になると思います。

また、今のパソコンにはRS232Cコネクタが付いていないので、USB-RS232C変換ケーブルを利用して、USBポートをRS-232CのCOMポートに割り当てられるようにして使用します。

VBAでTCP/IP通信する方法を紹介しています。

いろいろなセンサーの使い方を紹介しています。

コメント

  1. ITOM より:

    勉強のためでしょうが、わざわざ直さないと動かないように作られている。

    • ワッホー ワッホー より:

      ITOM様
      ご指摘ありがとうございます。

      以下2点の修正を致しました。
      1.portOpen()で、portOpenとすべきところをCommOpenとしている間違いがありました。
      2.CommandButton3_Click()で、wrkRsCommの引数に間違い(第3引数 vbcrLfが不要)がありました。

      間違いのないプログラムコードの掲載に努めておりますので、ご指摘して頂いて助かります。
      ありがとうございます。

  2. MH より:

    実行するとFunction portOpenの中で変数が定義されていないエラーが発生します。CreateFile内の記述は「port」ではなく「strport」が正しいのでしょうか?

    • ワッホー ワッホー より:

      MH様
      ご指摘ありがとうございます。
      おっしゃる通り、createFileの引数は、
      port → strPortが正しいです。
      プログラムに記述ミスがあったので修正しました。
      間違いのないプログラムコードの掲載に努めておりますので、ご指摘して頂いて助かります。
      ありがとうございます。

  3. レ ヅイ ハオ より:

    VBAプログラミングは今回初めてです。験機とPCをRS232Cで通信しようと思って、勉強しています。
    紹介していただいてありがとうございます。
    現在、このコードで実施していますが、送信ができない状態です。
    パソコンの環境の関係があるでしょうか?
    わかったらご教示していただけば、助かります。
    現在Windows10、64bit と office 2019です。

    • ワッホー ワッホー より:

      レ ヅイ ハオ様

      問い合わせありがとうございます。

      Windowsでシリアル通信ができるソフト(TeraTerm等)で、通信出来ることを確認してみるのはどうでしょうか。
      VBAプログラムのポート番号設定やボーレート設定の変更が必要かもしれません。

      漠然とした回答ですみません。
      よろしくお願いします。

  4. 新野好之 より:

    お伺いいたします。

    連続して読み取ることは可能でしょうか。

    マラソン大会のICチップを読み取り、時間と記録したいのですが。

    • ワッホー ワッホー より:

      新野様

      問い合わせありがとうございます。

      多分厳しいと思います。理由は以下の通りです。

      マラソン大会でICチップからの読み込みということで、パソコン(VBAプログラム)はいつデータが来てもいいように口を開けて待っている状態にすべきですが、紹介しているVBAプログラムは、パソコン(VBAプログラム)から外部機器へコマンドを送信して、その外部機器からの返事を受信する構造になっています。
      プログラムの構造自体が希望する動作にの向いていないので、読み取りを失敗するリスクは排除できないと思います。