|
|||||
|
VBA(EXCELやACCESS)でUDP/IP(ソケット)の送受信をするサンプルをご紹介します。 ------------------------------------------ (注意)このサンプルはVB6の開発環境が無いと実行出来ません。 EXCEL通信テスト(RS232C/TCPIP/UDPIP)でエクセルVBAのサンプルをダウンロード頂けます。 EXCEL通信テスト(RS232C/TCPIP/UDPIP)は自作OCX経由でMSWINSCK.OCXを使用するため VB6の開発環境は必要ありません。 ------------------------------------------ とりあえず、下の電文送受信サンプルソースを見てください。 通信(RS232C TCP/IP UDP/IP)関係のその他のツールやサンプルソースはこちらです。 通信ツール&サンプル(RS232C TCP/IP UDP/IP) ★VBAで電文の送受信をするサンプルソース Option Explicit '**************************************************************************** ' 機能名 : EXCEL通信テスト(UDP/IP) ' 機能説明 : EXCELを使用したUDP/IPの通信テストツール ' 著作権 : Copyright(C) 2010 のん All rights reserved ' 動作環境 : VB6の開発環境(特にMSWINSCK.OCX) '**************************************************************************** ' MSWINSCK.OCXを参照設定しています Private WithEvents Winsock1 As MSWinsockLib.Winsock ' 受信データ表示行番号 Private InputRow As Long ' ソケット(UDPIP)接続 Private Sub Btn_Open_Click() ' ソケット(UDPIP)接続チェック If Winsock1 Is Nothing = False Then MsgBox "既にソケット(UDPIP)が接続されています" Exit Sub End If ' 受信データ表示カラムをクリア Sheet1.Range("B15:B999") = "" ' 受信データ表示行番号初期化 InputRow = 15 ' ソケット(UDPIP)接続情報取得 Dim ip As String: ip = Sheet1.Cells(5, 4) Dim pt As String: pt = Sheet1.Cells(7, 4) Dim lo As String: lo = Sheet1.Cells(9, 4) ' ソケット(UDPIP)接続 Set Winsock1 = New MSWinsockLib.Winsock Winsock1.Protocol = sckUDPProtocol Winsock1.RemoteHost = ip Winsock1.RemotePort = pt Winsock1.Bind lo End Sub ' ソケット(UDPIP)切断 Private Sub Btn_Close_Click() ' ソケット(UDPIP)接続チェック If Winsock1 Is Nothing Then MsgBox "ソケット(UDPIP)が接続されていません" Exit Sub End If ' ソケット(UDPIP)切断 Winsock1.Close Set Winsock1 = Nothing End Sub ' ソケット(UDPIP)へデータ送信 Private Sub Btn_Send_Click() ' ソケット(UDPIP)接続チェック If Winsock1 Is Nothing Then MsgBox "ソケット(UDPIP)が接続されていません" Exit Sub End If ' 選択したセルのデータを送信データとする Dim sdat As String If ActiveCell.Row >= 4 And ActiveCell.Column >= 2 And _ ActiveCell.Row <= 13 And ActiveCell.Column <= 4 Then sdat = Sheet1.Cells(ActiveCell.Row, ActiveCell.Column) End If If sdat <> "" Then If Sheet1.Chk_SHex.Value = True Then ' 送信データをHEXコードから文字列に変換--ここから-- On Error Resume Next Dim i As Long ReDim shex(Int((Len(sdat) + 1) / 2) - 1) As Byte For i = 0 To Len(sdat) - 1 Step 2 shex(i / 2) = "&H" & Mid$(sdat, i + 1, 2) Next i On Error GoTo 0 ' 送信データをHEXコードから文字列に変換--ここまで-- ' ソケット(UDPIP)にデータ送信 Winsock1.SendData shex Else ' ソケット(UDPIP)にデータ送信 Winsock1.SendData sdat End If Else MsgBox "送信データ(セル)を選択してください。" End If End Sub ' ソケット(UDPIP)からデータ受信 Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) ' ソケット(UDPIP)接続チェック If Winsock1 Is Nothing Then 'MsgBox "ソケット(UDPIP)が接続されていません" Exit Sub End If Dim rdat As String: rdat = "" If Sheet1.Chk_RHex.Value = True Then ' ソケット(UDPIP)からデータ受信 Dim rhex() As Byte Winsock1.GetData rhex ' 受信データをHEXコードに変換--ここから---------------- Dim i As Long For i = 0 To UBound(rhex) Dim str As String str = "00" & Hex(rhex(i)) rdat = rdat & Right$(str, 2) Next i ' 受信データをHEXコードに変換--ここまで---------------- Else ' ソケット(UDPIP)からデータ受信 Winsock1.GetData rdat End If ' 受信データ表示セルに受信データを表示 rdat = Replace$(rdat, Chr(0), "") Sheet1.Cells(InputRow, 2) = "" & rdat InputRow = InputRow + 1 End Sub ' 送信データ選択カラム変更 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Sheet1.Unprotect Sheet1.Range("B4:C13").Font.ColorIndex = 0 If Target.Cells.Row >= 4 And Target.Cells.Row <= 13 And _ Target.Cells.Column >= 2 And Target.Cells.Column <= 3 Then Target.Font.ColorIndex = 3 End If Sheet1.Protect End Sub |
WEBフォームに入力したデータを保存し次回以降は自動入力。WEBページのログイン入力に。 WEB操作再生ツール WEBページの入力操作やクリック操作を記録/再生、コマ送り再生、ショートカットからの再生 WEB更新通知ツール WEBページの更新をチェックし通知(ブザー/アイコン点滅/バルーン表示)、変更内容の差分表示 指令メール実行 メールで遠隔操作(受信メールを監視しメールタイトルのキーワードに対応したファイルを実行) フォルダ監視人 ファイル更新監視:メール等通知(本文/差分/添付) プログラム実行(新/旧/差分指定) 同期 FTP対応 PC状況メール通知 PC使用状況通知(PC起動/PC終了/ログイン/ログアウト/指定ファイル更新時にログ出力/メール送信) フォルダ内のファイル比較ツール サブフォルダを含む全ファイル比較 文字コード判定比較 フォルダ同期 FTP対応 バッチ対応 テキスト差分表示ツール TEXT/EXCEL/WORD/HTTP/FTPの比較 差分出力(EXCEL/CSV) コマンドライン(バッチ)対応 文字コード判定&変換ツール.NET SJIS/JIS/EUC/UNICODE/UTF-7/UTF-8対応 File/Folder可 コマンドライン/送るメニュー可 TCP/IP-RS232C中継機 TCP/IPとRS232Cのプロトコル変換、送受信電文のログ表示/保存、タスクトレイ動作可 RS232C共有 まだまだ沢山あります ... |