【Excel VBA（2013 64bit版対応）】Winsockを利用したUDPクライアント、UDPサーバーサンプル

この記事でできること

Excel VBA（64bit版Office）を使用して、Windows Sockets（Winsock API）を利用したUDP通信によるデータの送信（クライアント）および受信（サーバー）を行うことができます。マルチプロセス構成によって、クライアント用ブックとサーバー用ブックを分けてデータをやり取りする方法を確認できます。

想定環境・前提条件

• OS: Windows 10 / 11 (64bit)
• アプリケーション: Microsoft Excel 2013以降（64bit版）
• ネットワーク環境: ローカルループバック（127.0.0.1）での検証を想定

UDPクライアントのサンプルコード

以下のコードをクライアント側の標準モジュールに配置し、UDPSendを実行することでローカルポートへテストデータを送信できます。

Option Explicit

Public Const SOCKET_ERROR As Long = -1
Public Const IPPROTO_UDP As Long = 17
Public Const AF_INET = 2
Public Const SOCK_DGRAM = 2
Public Const WS_VERSION_REQD As Long = &H101
Public Const IP_SUCCESS As Long = 0

Public Type WSAData
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * 257
    szSystemStatus As String * 129
    iMaxSockets As Integer
    iMaxUDPDG As Integer
    lpVendorInfo As Long
End Type

Public Type SOCKADDR_IN
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type

Public Declare PtrSafe Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired As Integer, lpWSADATA As WSAData) As Long
Public Declare PtrSafe Function WSACleanup Lib "wsock32.dll" () As Long
Public Declare PtrSafe Function w_socket Lib "wsock32.dll" Alias "socket" (ByVal lngAf As LongPtr, ByVal lngType As LongPtr, ByVal lngProtocol As LongPtr) As Long
Public Declare PtrSafe Function w_closesocket Lib "wsock32.dll" Alias "closesocket" (ByVal socketHandle As LongPtr) As Long
Public Declare PtrSafe Function w_sendTo Lib "wsock32.dll" Alias "sendto" (ByVal SOCKET As LongPtr, buf As Any, ByVal length As LongPtr, ByVal Flags As LongPtr, remoteAddr As SOCKADDR_IN, ByVal remoteAddrSize As LongPtr) As Long
Public Declare PtrSafe Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Long
Public Declare PtrSafe Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long

Public Function SocketsInitialize() As Boolean
    Dim WSAD As WSAData
    SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function

Sub UDPSend()
    If (Not SocketsInitialize()) Then
        MsgBox "Error initializing WinSock"
        Exit Sub
    End If

    Dim SendSocketHandle As LongPtr
    SendSocketHandle = w_socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP)

    Dim remoteAddr As SOCKADDR_IN
    Dim ip As String: ip = "127.0.0.1"
    Dim remotePort As Long: remotePort = 65501
    
    remoteAddr.sin_family = AF_INET
    remoteAddr.sin_addr = inet_addr(ip)
    remoteAddr.sin_port = htons(remotePort)
    
    Dim strbuffer As String: strbuffer = "test message"
    If strbuffer <> "" Then
        Debug.Print w_sendTo(SendSocketHandle, ByVal strbuffer, Len(strbuffer), 0, remoteAddr, LenB(remoteAddr))
    End If
    
    w_closesocket SendSocketHandle
    WSACleanup
End Sub

UDPサーバーのサンプルコード

以下のコードをサーバー側の標準モジュールに配置し、UDPRecvを実行することで指定ポートのデータ待ち受けを行います。

Option Explicit

Public Const SOCKET_ERROR As Long = -1
Public Const IPPROTO_UDP As Long = 17
Public Const AF_INET = 2
Public Const SOCK_DGRAM = 2
Public Const WS_VERSION_REQD As Long = &H101
Public Const IP_SUCCESS As Long = 0
Public Const FIONBIO = &H8004667E

Public Type WSAData
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * 257
    szSystemStatus As String * 129
    iMaxSockets As Integer
    iMaxUDPDG As Integer
    lpVendorInfo As Long
End Type

Public Type SOCKADDR_IN
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type

Public Declare PtrSafe Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired As Integer, lpWSADATA As WSAData) As Long
Public Declare PtrSafe Function WSACleanup Lib "wsock32.dll" () As Long
Public Declare PtrSafe Function w_socket Lib "wsock32.dll" Alias "socket" (ByVal lngAf As LongPtr, ByVal lngType As LongPtr, ByVal lngProtocol As LongPtr) As Long
Public Declare PtrSafe Function w_closesocket Lib "wsock32.dll" Alias "closesocket" (ByVal socketHandle As LongPtr) As Long
Public Declare PtrSafe Function w_bind Lib "wsock32.dll" Alias "bind" (ByVal SOCKET As LongPtr, Name As SOCKADDR_IN, ByVal namelen As LongPtr) As Long
Public Declare PtrSafe Function w_recvFrom Lib "wsock32.dll" Alias "recvfrom" (ByVal SOCKET As LongPtr, buf As Any, ByVal length As LongPtr, ByVal Flags As Long, fromAddr As SOCKADDR_IN, fromAddrSize As Long) As Long
Public Declare PtrSafe Function ioctlsocket Lib "wsock32.dll" (ByVal s As LongPtr, ByVal cmd As Long, argp As Long) As Long
Public Declare PtrSafe Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Long
Public Declare PtrSafe Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Function SocketsInitialize() As Boolean
    Dim WSAD As WSAData
    SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function

Sub UDPRecv()
    Dim ip As String: ip = "127.0.0.1"
    Dim listenPort As Long: listenPort = 65500
    
    If (Not SocketsInitialize()) Then
        MsgBox "Error initializing WinSock"
        Exit Sub
    End If
    
    Dim ListenSocketHandle As LongPtr
    ListenSocketHandle = w_socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP)
    
    Dim remoteAddr As SOCKADDR_IN
    remoteAddr.sin_family = AF_INET
    remoteAddr.sin_addr = inet_addr(ip)
    remoteAddr.sin_port = htons(listenPort)
    
    If w_bind(ListenSocketHandle, remoteAddr, LenB(remoteAddr)) = SOCKET_ERROR Then
        MsgBox "Error binding listener socket"
        GoTo EXIT_POINT
    End If
    
    Dim Enabled As Long: Enabled = 1
    If ioctlsocket(ListenSocketHandle, FIONBIO, Enabled) = SOCKET_ERROR Then
        MsgBox "Error nonblocking mode setting"
        GoTo EXIT_POINT
    End If
    
    Dim recvBuffer As String * 2048
    Dim recvresult As Long
    
    Do While True
        DoEvents
        Sleep 1000
        recvresult = w_recvFrom(ListenSocketHandle, ByVal recvBuffer, Len(recvBuffer), 0, remoteAddr, LenB(remoteAddr))
        If (recvresult > 0) Then
            MsgBox "サーバー受信成功: " & Trim(recvBuffer)
            Exit Do
        End If
    Loop
    
EXIT_POINT:
    w_closesocket ListenSocketHandle
    WSACleanup
End Sub

実行手順と期待される結果

1. Excelを2つ起動し、それぞれクライアント用・サーバー用のVBAプロジェクト標準モジュールに上記のコードを貼り付けます。
2. サーバー側で UDPRecv を実行し、ノンブロッキングモードによる受信待機状態にします。
3. クライアント側で UDPSend を実行すると、サーバー側のメッセージボックスに送信された文字列が表示されます。

セキュリティ・制約事項

– 本記事のコードはローカル環境（127.0.0.1）での動作検証を基本としています。
– 64bit版Office環境に対応させるため、API宣言には PtrSafe および LongPtr を使用しています。