| |
▼savex さん：
# もうご覧になっていないかも知れませんが。
結局、GetPrinterにしても、WMIにしても、
こちらの環境でも上手く取れないので、
取り合えず、コントロールパネルの
プリンタウィンドウ(画面)から取得するのが
まあ、直感的かなと。
EnumWindows。EnumChildWindowsで
プリンタウィンドウの起動待ちを一応、兼ねています。
FAQ｜Excel （VBA）
moug.net/faq/viewforum.php?f=2
でかなり前に載せられたshiraさんのコードを
お借りしてます(IAccessible関連)。
こちらも参考。
www.roy.hi-ho.ne.jp/mutaguchi/wsh/technic.htm
では。
Option Explicit
'標準モジュール
Private Declare Function EnumWindows Lib "user32" _
(ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" _
(ByVal hWndParent As Long, ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Private Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function GetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" _
(ByVal hwnd As Long, ByVal dwId As Long, _
riid As Any, ppvObject As Any) As Long
Const OBJID_CLIENT = &HFFFFFFFC
Private Declare Function IIDFromString Lib "ole32" _
(lpsz As Any, lpiid As Any) As Long
Const IID_IAccessible = "{618736E0-3C3D-11CF-810C-00AA00389B71}"
Const WM_CLOSE = &H10
Private Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" _
(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Private h As Long
Private hSysListView32 As Long
Private Function EnumWindowsProc(ByVal hwnd As Long, _
ByVal lParam As Long) As Long
Dim ClassName As String * 128
Dim WindowText As String * 128
GetClassName hwnd, ClassName, Len(ClassName)
GetWindowText hwnd, WindowText, Len(WindowText)
If WindowText Like "プリンタ*" Then
If ClassName Like "CabinetWClass*" Then
h = hwnd
EnumChildWindows hwnd, AddressOf EnumChildProc, 0
EnumWindowsProc = 0
End If
End If
EnumWindowsProc = 1
End Function
Private Function EnumChildProc(ByVal hwnd As Long, _
ByVal lParam As Long) As Long
Dim ClassName As String * 128
Dim WindowText As String * 128
GetClassName hwnd, ClassName, Len(ClassName)
GetWindowText hwnd, WindowText, Len(WindowText)
If ClassName Like "SysListView32*" Then
hSysListView32 = hwnd
EnumChildProc = 0
End If
EnumChildProc = 1
End Function
' こちらを実行
Sub test()
Dim IID(0 To 3) As Long
Dim acc As IAccessible
Dim i As Long
Dim obj As Object
h = 0
hSysListView32 = 0
For Each obj In CreateObject("Shell.Application").Namespace(3).Items
If obj.Name = "プリンタ" Then
obj.InvokeVerb
End If
Next
EnumWindows AddressOf EnumWindowsProc, 0
' ウィンドウからIAccessibleを取り出す
IIDFromString ByVal StrPtr(IID_IAccessible), IID(0)
If AccessibleObjectFromWindow( _
hSysListView32, OBJID_CLIENT, IID(0), acc) < 0 Then
Exit Sub ' エラー時
End If
'IAccessibleベースのオブジェクト作成待ち(適当)
'これに気付かなくてしばらくハマッた。
'この時の内部動作を調べれば確実に
'オンライン/オフラインを判断できるのではと。
Application.Wait Now() + TimeValue("00:00:01")
For i = 1 To acc.accChildCount - 1
Debug.Print acc.accName(i) 'プリンタ名
Debug.Print acc.accDescription(i) 'OnLine/OffLine確認
Next
Set acc = Nothing
'プリンタウィンドウを閉じる
PostMessage h, WM_CLOSE, 0, 0
'プリンタウィンドウが閉じるのを待つ
Do
DoEvents
Loop While IsWindow(h) = 0
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
