| |
▼ichinose さん お礼遅くなって申し訳けありません
両方実行してみました。
・｢shell.application」
98系では動いたのですが XPでは動きませんでした
・shousukeさんのAPI
98系,XP系で動きました
私の変更の仕方が悪かったのか 続けて行うと 前回の内容を持ってきてしまいました
(1回目ﾌﾟﾘﾝﾀｰ接続件数=3 ,2回目実行時のﾌﾟﾘﾝﾀｰ接続件数=5)
通常は 1回のみ実効のため 問題ないかと思います
業務で使うマクロ作れそうです ありがとうございました
ﾛｸﾞが数件に分かれていて 不慣れな私には 分かりづらかったため 私の作った物を記載します
Sub 接続プリンター表示_API()
プリンタ名収集
MsgBox "現在接続しているﾌﾟﾘﾝﾀｰ : " & Get_Printer_Idx + 1
For i = 0 To Get_Printer_Idx Step 1
MsgBox "現在接続しているﾌﾟﾘﾝﾀｰ : " & Get_Printer_Name(i) & " on " & Get_Printer_Port(i)
Next
End Sub
Public Declare Function GetProfileString Lib "kernel32" Alias _
"GetProfileStringA" (ByVal lpAppName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long) As Long
Public Get_Printer_Name(20) As String
Public Get_Printer_Port(20) As String
Public Get_Printer_Idx As Integer
Public Sub プリンタ名収集()
Dim vntArray As Variant, Element As Variant
Dim intCount As Integer, strPrinter As String, intPos As Integer, strPort As String
Get_PRINT_IDX = 0
'エントリ検索
vntArray = API_GetProfileString("Devices", vbNullString, "NotFound", 1024, Chr(0))
If IsEmpty(vntArray) = False Then
For intCount = LBound(vntArray) To UBound(vntArray)
'キー検索
strPrinter = vntArray(intCount) 'プリンタ名
Element = API_GetProfileString("Devices", strPrinter, "NotFound", 1024, Chr(0))
If IsEmpty(Element) = False Then
intPos = InStr(1, Element(0), ",")
'区切り文字（,）位置
If intPos <> 0 Then strPort = Mid(Element(0), intPos + 1, Len(Element(0)) - intPos)
'====================
'Debug.Print strPort & " on " & strPrinter
'====================
Get_Printer_Name(Get_Printer_Idx) = strPrinter
Get_Printer_Port(Get_Printer_Idx) = strPort
Get_Printer_Idx = Get_Printer_Idx + 1
End If
Next intCount
End If
Get_Printer_Idx = Get_Printer_Idx - 1
End Sub
'以下は関数＊＊＊
Public Function API_GetProfileString(strAppName As String, strKeyName As String, strDefault As String, _
lngSize As Long, strDelimiter As String) As Variant
Dim strBuf As String '情報を取得するためのバッファ
Dim lngResult As Long '戻り値
Dim lngStart As Long, lngPos As Long
Dim strTemp As String, strArray() As String, intCount As Integer
'On Error Resume Next
'---------------------------------------------------------------------------
'関数の呼び出し
'---------------------------------------------------------------------------
'WIN.INI からの情報を取得するためのバッファ
strBuf = Space(lngSize)
'WIN.INI から指定したエントリないでキーを検索、該当データのバイト数を返す
lngResult = GetProfileString(strAppName, strKeyName, strDefault, strBuf, lngSize)
'戻り値（テンポラリ）
strTemp = Trim(Left(strBuf, lngResult))
'---------------------------------------------------------------------------
'戻り値チェック
'---------------------------------------------------------------------------
If strTemp = Empty Then API_GetProfileString = Empty: Exit Function 'キーなし時
If strTemp = strDefault Then API_GetProfileString = Empty: Exit Function '該当なし時
lngStart = 1: intCount = Empty
'**********
'複数戻り値の場合のチェック
Do
lngPos = InStr(lngStart, strTemp, strDelimiter) 'データ区切り位置検出
If lngPos = 0 And (lngStart > 1) Then Exit Do 'データ区切りなし時終了
If Mid(strTemp, lngStart, 1) <> strDelimiter Then
'区切られたデータを配列に格納
ReDim Preserve strArray(intCount) As String
If lngPos = 0 Then
strArray(intCount) = strTemp
Else
strArray(intCount) = Mid(strTemp, lngStart, lngPos - lngStart)
End If
End If
lngStart = lngPos + 1 '検索開始位置
intCount = intCount + 1 '配列の要素インデックス増
Loop Until lngPos = 0
'**********
'戻り値
API_GetProfileString = strArray
End Function
|
|
hwata
- 06/10/26(木) 9:38 -
