'API's



Private Declare Function RegOpenKey Lib "advapi32.dll" _

  Alias "RegOpenKeyA" (ByVal hKey As Long, _

  ByVal lpSubKey As String, phkResult As Long) As Long





Private Declare Function RegCreateKey Lib "advapi32.dll" _

  Alias "RegCreateKeyA" (ByVal hKey As Long, _

  ByVal lpSubKey As String, phkResult As Long) As Long



Private Declare Function RegSetValueEx Lib "advapi32.dll" _

  Alias "RegSetValueExA" (ByVal hKey As Long, _

  ByVal lpValueName As String, ByVal Reserved As Long, _

  ByVal dwType As Long, lpData As Any, ByVal cbData As Long) _

  As Long

  

Private Declare Function RegCloseKey Lib "advapi32.dll" _

  (ByVal hKey As Long) As Long



'Konstanten

Const HKEY_LOCAL_MACHINE = &H80000002

Const REG_SZ = 1



'Sub zum Speichern in die Registry

Sub SaveToReg(hKey As Long, sPath As String, _

  sValue As String, ByVal iData As String)



  Dim vRet As Variant



  RegCreateKey hKey, sPath, vRet

  RegSetValueEx vRet, sValue, 0, REG_SZ, ByVal iData, _

    Len(iData)

  RegCloseKey vRet

End Sub



'Hauptprogramm

Sub main()



Dim i, k, x, ff As Integer

Dim devname, myComment, pfad, prt() As String



pfad = "Crinters.txt" 'Pfad zur Textdatei mit den Druckernamen deren Comments geändert werden sollen



myComment = "Kommentar" 'Das ist der Kommentar





ff = FreeFile

Open pfad For Input As #ff

    x = -1 'Damit der Feldindex von prt() auch beim ersten Durchlauf stimmt

    Do While Not EOF(ff)

        x = x + 1

        ReDim Preserve prt(x)

        Line Input #ff, prt(UBound(prt))

    Loop



Close #ff



For i = 0 To Printers.Count - 1

    devname = Printers(i).DeviceName 'Druckernamen herausfinden

    For k = 0 To UBound(prt)

        If devname = prt(k) Then

            'Kommentar in die Registry schreiben

            SaveToReg HKEY_LOCAL_MACHINE, "SystemCurrentControlSetControlPrintPrinters\" & devname, "Description", myComment

        End If

    Next k

Next i



End Sub