Jeg har haft samme problem og fandt
'
http://msdn.microsoft.com/en-us/library/aa394600(VS.85).aspx
hos Microsoft og har rettet koden lidt til for at få fat på den irriterende kode, der står efter printernavnet på de enkelte maskiner. Du skal hente f.eks. 'neo00' fra registreringsdatabasen.
Du skal nok rette lidt til. Jeg har skrevet et par kommentarer, hvor jeg mener, du skal rette. Jeg håber, jeg har fået det hele med.
Klip nedenstående kode ud og set det i et separat modul
Kald koden med en variabel: printernavn = GetPrinter
Så vil du have hele det korrekte printernavn i variablen printernavn, og kan printe til den printer.
Option Explicit
Public Enum Hive
HKEY_CLASSES_ROOT
HKEY_CURRENT_USER
HKEY_LOCAL_MACHINE
HKEY_USERS
HKEY_CURRENT_CONFIG
End Enum
Function GetPrinter() As String
Dim ActPrt As String
Dim pos As Integer
Dim registryKey As String
Dim keyName As String
ActPrt = Application.ActivePrinter
registryKey = "Software\Microsoft\Windows NT\CurrentVersion\Devices"
' *** Ændr IP en del af IP adressen, hvor der står "10.217" nedenfor
pos = InStr(InStr(1, ActPrt, "10.217"), ActPrt, " ") - 1
' *** KeyName = den printer, du vil printe på.
keyName = Left(ActPrt, pos) & " - Tilbud"
' get string value from registry
GetPrinter = keyName & " på " & Mid(GetStringValFromRegistry(HKEY_CURRENT_USER, registryKey, keyName), 10, 4) & ":"
End Function
Function GetHive(hivetype As Hive) As Variant
' return enumerated value depending on the hive chosen
Select Case hivetype
Case 0
GetHive = &H80000000 ' HKEY_CLASSES_ROOT
Case 1
GetHive = &H80000001 ' HKEY_CURRENT_USER
Case 2
GetHive = &H80000002 ' HKEY_LOCAL_MACHINE
Case 3
GetHive = &H80000003 ' HKEY_USERS
Case 4
GetHive = &H80000005 ' HKEY_CURRENT_CONFIG
End Select
End Function
Function GetStringValFromRegistry(hivetype As Hive, registryKey As String, _
keyValue As String) As String
Dim objReg As Object
Dim strKeyPath As String
Dim ValueName As String
Dim strValue As String
Set objReg = GetStdRegProv
strKeyPath = registryKey
ValueName = keyValue
' put key value into strValue variable
objReg.GetStringValue GetHive(hivetype), strKeyPath, ValueName, strValue
GetStringValFromRegistry = strValue
End Function
Function GetStdRegProv() As ObjectDim strComputer As String
strComputer = "."
Set GetStdRegProv = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\default:StdRegProv")
End Function
