| |
でん さん、kein さん、こんばんは。
ジョブ数だけならこんな方法はいかがですか？
以下の仕様は、アクティブシートのＡ列にプリンター名、Ｂ列にジョブ数を書き込む例です。
標準モジュール（Module1）に
'=============================================================
Sub main()
Dim pr_name
Dim jbcount
If open_printer = True Then
idx = 1
pr_name = get_printer_name(True)
Do While pr_name <> ""
jbcount = get_printer_job_count(pr_name)
If VarType(jbcount) <> vbBoolean Then
Cells(idx, 1).Value = pr_name
Cells(idx, 2).Value = get_printer_job_count(pr_name)
End If
idx = idx + 1
pr_name = get_printer_name()
Loop
Call close_printer
End If
End Sub
標準モジュール（Module2）に
'=======================================================
' プリンター名i/oプロシジャーパック
'=======================================================
Dim fol
Dim folds
Dim pr_array() As String
Dim pr_idx()
'=======================================================
Function open_printer() As Boolean
'プリンター名をpr_arrayに、FolderitemのIDをpr_idx()にセット
' output open_printer true 正常終了
' false 異常終了
On Error GoTo err_open_printer
Dim myshell
open_printer = True
Erase pr_array
Erase pr_idx
Set myshell = CreateObject("shell.application")
Set fol = myshell.NameSpace(4)
Set folds = fol.items
idx = 0: jdx = 1
Do While idx <= folds.Count - 1
Set fold = folds.Item(idx)
If Not fold.Name Like "プリンタ*" Then
ReDim Preserve pr_array(1 To jdx)
pr_array(jdx) = fold.Name
ReDim Preserve pr_idx(1 To jdx)
pr_idx(jdx) = idx
jdx = jdx + 1
End If
idx = idx + 1
Loop
ret_open_printer:
Set myshell = Nothing
On Error GoTo 0
Exit Function
err_open_printer:
MsgBox Error$(Err.Number)
open_printer = False
Resume ret_open_printer
End Function
'=======================================================
Function get_printer_name(Optional first As Boolean = False)
' プリンター名を取り出す(dir関数に使い方が似てる?)
' input first : true 最初のプリンタ名
' false 次のプリンタ名
' output get_printer_name : プリンタ名
On Error Resume Next
Static idx
If first = True Then
idx = 1
End If
get_printer_name = ""
If idx <= UBound(pr_array()) Then
get_printer_name = pr_array(idx)
idx = idx + 1
End If
On Error GoTo 0
End Function
'=======================================================
Function get_printer_job_count(pr_nm)
'指定されたプリンタ名に該当するプリンタのジョブ数を取得する
'input pr_nm : プリンタ名
'output get_printer_job_count 数値:正常ジョブ数 false:失敗
On Error Resume Next
Dim id
id = WorksheetFunction.Match(pr_nm, pr_array(), 0)
If Err.Number = 0 Then
get_printer_job_count = fol.GetDetailsOf(folds.Item(pr_idx(id)), 1)
If Err.Number <> 0 Then
get_printer_job_count = False
End If
Else
get_printer_job_count = False
End If
On Error GoTo 0
End Function
'=======================================================
Sub close_printer()
'プリンタ名i/oの終了
On Error Resume Next
Erase pr_array
Erase pr_idx
Set fol = Nothing
Set folds = Nothing
On Error GoTo 0
End Sub
前に作ってあったものに追加したコードなので余計なコードも入っていますが、
確認後に改良して下さい。
|
|
