Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


25728 / 76735 ←次へ | 前へ→

【56345】Re:プリンタの電源確認について
回答  熊谷隆史  - 08/6/14(土) 10:39 -

引用なし
パスワード
   ▼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

0 hits

【56128】プリンタの電源確認について savex 08/6/3(火) 17:19 質問
【56179】Re:プリンタの電源確認について 熊谷隆史 08/6/7(土) 18:05 発言
【56266】Re:プリンタの電源確認について yasu 08/6/12(木) 11:21 発言
【56267】Re:プリンタの電源確認について savex 08/6/12(木) 11:59 お礼
【56302】Re:プリンタの電源確認について 熊谷隆史 08/6/12(木) 17:35 発言
【56345】Re:プリンタの電源確認について 熊谷隆史 08/6/14(土) 10:39 回答
【56362】Re:プリンタの電源確認について 熊谷隆史 08/6/15(日) 10:55 回答

25728 / 76735 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free