Excel VBA質問箱 IV

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

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


38074 / 76732 ←次へ | 前へ→

【43801】Re:プリンター名の習得
お礼  hwata  - 06/10/26(木) 9:38 -

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

0 hits

【43715】プリンター名の習得 hwata 06/10/23(月) 15:55 質問
【43716】Re:プリンター名の習得 Blue 06/10/23(月) 16:00 発言
【43802】Re:プリンター名の習得 hwata 06/10/26(木) 9:41 お礼
【43807】Re:プリンター名の習得 Blue 06/10/26(木) 10:16 発言
【43719】Re:プリンター名の習得 ichinose 06/10/23(月) 16:42 発言
【43800】Re:プリンター名の習得 hwata 06/10/26(木) 9:38 お礼
【43801】Re:プリンター名の習得 hwata 06/10/26(木) 9:38 お礼

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