こちらの続きです。
ファイル間リンクの取得2 - C#ATIA
3年程前に断念したVBAでのファイル間リンク情報取得なのですが、
昨日から少し手ごたえを感じています。
元にしているコードはこちらです。
Catia V5 Get Links
過去に紹介したサイトが幾つも消えてしまっているのですが、
消えていなくて助かっています。が、あまりにコードが汚いのも本音です。
「リンク...」(英語環境 Links...)コマンドを実行し、出てくるダイアログの情報を
WinAPIでゴリゴリに取得しようと言うマクロなのですが、大元は32bitの頃に
作成されたもので、前回取り組んだ際はOSが64bitでVBAが32bitだったような
記憶です。
まだ途中ですが、ダイアログのリストビューにアクセスする辺りまでのコードです。
'vba リンクダイアログ取得テスト Option Explicit '--- win api --- Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" ( _ ByVal hwnd As LongPtr, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) _ As Long '-- Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" ( _ ByVal hwnd As LongPtr, _ ByVal msg As Long, _ ByVal wParam As Long, _ ByVal lParam As Any _ ) As Long 'Ptr Private Declare PtrSafe Function SendMessageStr Lib "user32" Alias "SendMessageA" ( _ ByVal hwnd As LongPtr, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As String) _ As Long 'Ptr Private Declare PtrSafe Function SendMessageAny Lib "user32" Alias "SendMessageA" ( _ ByVal hwnd As LongPtr, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) _ As Long 'Ptr Private Const WM_GETTEXT = &HD Private Const HDM_GETITEMCOUNT = (&H1200 + 0) Private Const WM_CLOSE = &H10 Private Const LVM_FIRST As Long = &H1000 Private Const LVM_GETITEMCOUNT = (LVM_FIRST + 4) Private Const LVM_GETITEM As Long = (LVM_FIRST + 5) Private Const LVM_GETHEADER = (LVM_FIRST + 31) Private Const LVM_SETITEMSTATE = (LVM_FIRST + 43) Private Const LVM_GETITEMSTATE = (LVM_FIRST + 44) Private Const LVM_GETITEMTEXT = LVM_FIRST + 45 '-- Private Declare PtrSafe Function EnumChildWindows Lib "user32" ( _ ByVal hWndParent As LongPtr, _ ByVal lpEnumFunc As LongPtr, _ ByVal lParam As Long) _ As Long Private Declare PtrSafe Function ShowWindow Lib "user32" ( _ ByVal hwnd As LongPtr, _ ByVal nCmdShow As Long) _ As Long Private Const SW_HIDE = 0 Private Const SW_SHOW = 5 Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) _ As LongPtr Private Declare PtrSafe Function GetWindow Lib "user32" ( _ ByVal hwnd As LongPtr, _ ByVal wCmd As Long) _ As LongPtr Private Const GW_HWNDNEXT = 2 Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _ ByVal hwnd As LongPtr, _ ByVal lpString As String, _ ByVal cch As Long) _ As Long Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () _ As LongPtr Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '-- Private F_hwnd As LongPtr Private L_hwnd As LongPtr Private ListCount As Long Sub CATMain() 'コマンド実行 CATIA.StartCommand ("リンク...") ' ("Links...") ' CATIA.RefreshDisplay = True 'リンクダイアログ取得 F_hwnd = FindWindowLike("ドキュメントのリンク") '("Links of document") ' 'ShowWindow F_hwnd, SW_HIDE 'リンクダイアログ内のリストビュー(SysListView32)ハンドル取得 Sleep 100 Call EnumChildWindows(F_hwnd, AddressOf EnumChildWindow, 0) 'Row数 Dim rows As Long rows = SendMessageStr(L_hwnd, LVM_GETITEMCOUNT, 0, 0) 'リストビューヘッダーのハンドル取得 : Column数取得に必要 Dim hWndHeader As Long 'Long hWndHeader = SendMessage(L_hwnd, LVM_GETHEADER, 0, ByVal 0&) 'Column数 Dim cols As Long cols = SendMessageStr(hWndHeader, HDM_GETITEMCOUNT, 0, 0) 'リンクダイアログ閉じる 'ShowWindow F_hwnd, SW_SHOW SendMessageAny F_hwnd, WM_CLOSE, 0, 0 Stop End Sub Private Function EnumChildWindow( _ ByVal hChild As LongPtr, _ ByVal lParam As LongPtr) _ As Long Dim iClass As String Dim iText As String Dim j As LongPtr iClass = String(255, vbNullChar) 'Space(256) j = GetClassName(hChild, iClass, 63) iClass = Left(iClass, CLng(j)) iText = String(255, vbNullChar) 'Space(256) j = SendMessageStr(hChild, WM_GETTEXT, 255, iText) iText = Left(iText, CLng(j)) If iClass = "SysListView32" Then ListCount = ListCount + 1 If ListCount = 2 Then L_hwnd = hChild: EnumChildWindow = 0: Exit Function End If End If EnumChildWindow = 1 ' Continua enumerarea End Function Private Function FindWindowLike( _ strPartOfCaption As String) _ As LongPtr Dim hwnd As LongPtr Dim strCurrentWindowText As String Dim r As Integer hwnd = GetForegroundWindow Do Until hwnd = 0 strCurrentWindowText = String(255, vbNullChar) 'Space(256) r = GetWindowText(hwnd, strCurrentWindowText, 255) strCurrentWindowText = Left$(strCurrentWindowText, r) If InStr(1, LCase(strCurrentWindowText), LCase(strPartOfCaption)) <> 0 Then GoTo Found hwnd = GetWindow(hwnd, GW_HWNDNEXT) Loop Exit Function Found: FindWindowLike = hwnd End Function
正直な所、
・WinAPIの引き数・戻り値の型に自信が有りません
・EnumChildWindow、FindWindowLikeは動くレベルまでの
修正しかしていません。
実際に実行してみるとこんな感じです。
ローカルウィンドウに表示されているものは、リンクのダイアログに入っている
リストビューの行と列の数等で、それなりに取得できているのがわかります。
(あまりに汚いのでコードを記載していませんが、その後のコードで
リンク情報は全て取得出来ています)
悩んでいるのは、2度目以降実行すると
数値が取得出来なくなります。何故?
単に取得する際のSendMessage類が機能しないのか?
一回目の実行後の終了の仕方が悪いのか?
何をどうすれば良いのか・・・。
但し、この様な操作をすると、再度取得が出来ます。
例えば、WinAPIのSendMessage関数の戻り値の型をこんな感じに
修正します。
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" ( _ ・・・ ) As Long 'Ptr ↓ ) As LongPtr
当然、SendMessage関数の利用先では型の不一致でエラーとなります。
そこで、SendMessage関数の戻り値の型を元に戻すと再び正しく取得出来ます。
但し1度だけです。
感覚的に、宣言セクションにある程度影響のある修正を加えると、1度だけ
正しく取得出来ているような感じです。
どうでも良い部分にスペースを入れて、削除ぐらいではダメなんですが。
この様な現象を経験された方いらっしゃいませんか?
どの様に対策を取れば良いのだろう?
不安定な挙動なので、何かしらが正しくなくてギリギリ動いているのは
実感しているのですが、ゴールへの道筋があるのに辿り着けない・・・。