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