Private 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
Function GetDeviceName() As String
Dim di As String
def$ = String(128, 0)
di = GetProfileString("WINDOWS", "DEVICE", "", def$, 127)
GetDeviceName = Trim(def$)
GetDeviceName = Left(GetDeviceName, InStr(GetDeviceName, ",") - 1)
End Function
Private Sub Command1_Click()
Dim a As String
MsgBox GetDeviceName
a = GetDeviceName()
Call setDefaultPrinter_To_System("PDF995")
End Sub


Public Sub setDefaultPrinter_To_System(devcName As String)
    Dim X As Printer
    Dim WshNetwork As Object
    Dim k As Long


    k = 0
    For Each X In Printers
       If X.DeviceName = devcName Then
          ' Set printer as system default.
          Set Printer = X
          Set WshNetwork = CreateObject("WScript.Network")
          WshNetwork.setDefaultPrinter (Printers(k).DeviceName)
          ' Stop looking for a printer.
          Exit For
       End If
       k = k + 1
    Next
    
End Sub