vba设置默认打印机失败

cunfu2010

Sub test()
    Dim WshNetwork As Object, sPrintName As String
    Set WshNetwork = CreateObject("WScript.Network")
    sPrintName = "HP LaserJet P1007"
    WshNetwork.SetDefaultPrinter sPrintName
End Sub
使用CreateObject("WScript.Network").SetDefaultPrinter设置默认打印机失败，请大神指点一下

lss001

Sub test()
    Dim WshNetwork As Object
    Dim WshEunm As Object, i%

    Set WshNetwork = CreateObject("WScript.Network")
    Set WshEunm= WshNetwork.EnumPrinterConnections
   
    sPrintName = "HP LaserJet P1007" '指定打印机名称
    For i = 0 To WshEunm.Count - 1 Step 2
        If InStr(1, WshEunm(i + 1), sPrintName) Then
           WshNetwork.SetDefaultPrinter WshEunm(i + 1) '设置默认打印机

        End If
    Next

    MsgBox "当前打印机名称：" & Application.ActivePrinter
End Sub

cunfu2010

lss001 发表于 2025-4-2 09:09
Sub test()
    Dim WshNetwork As Object
    Dim WshEunm As Object, i%

感谢！但这样我的电脑还是设置不成功，不知道是电脑的问题，还是office的问题

cunfu2010

其他大神这样设置都能成功吗？

lss001

cunfu2010 发表于 2025-4-2 18:15
其他大神这样设置都能成功吗？

'检查一下打印机名称是否拼写正确
'或用以下代码检查一下是否存在指定打印机名称

Sub 获取系统全部打印机名称()
    Dim WshNetwork As Object
    Dim WshEunm As Object, i%

    Set WshNetwork = CreateObject("WScript.Network")
    Set WshEunm= WshNetwork.EnumPrinterConnections
   
    For i = 0 To WshEunm.Count - 1 Step 2
       Debug.Print WshEunm(i + 1) '打印机名称
       Debug.Print WshEunm(i) '打印机端口
    Next

End Sub

cunfu2010

lss001 发表于 2025-4-2 18:48
'检查一下打印机名称是否拼写正确
'或用以下代码检查一下是否存在指定打印机名称

打印机名称拼写没问题。
用Application.ActivePrinter=“HP LaserJet P1007 在 Ne01:”设置可以成功，但Ne端口还得查，比较麻烦，想直接用打印机名称设置，不成功。我看坛子里有各位老师给出的可以用CreateObject("WScript.Network")设置，我这儿怎么调试都不行，这才发帖求教

lss001

cunfu2010 发表于 2025-4-3 07:33
打印机名称拼写没问题。
用Application.ActivePrinter=“HP LaserJet P1007 在 Ne01:”设置可以成功，但 ...

'''如果WMI无法设置，可以试试WindowsAPI设置

Type PRINTER_INFO_5
        pPrinterName As Long
        pPortName As Long
        Attributes As Long
        DeviceNotSelectedTimeout As Long
        TransmissionRetryTimeout As Long
End Type

Private Declare PtrSafe Function EnumPrinters _
    Lib "winspool.drv" Alias "EnumPrintersA" ( _
    ByVal flags As Long, _
    ByVal name As String, _
    ByVal Level As Long, _
    pPrinterEnum As Any, _
    ByVal cdBuf As Long, _
    pcbNeeded As Long, _
    pcReturned As Long) As Long
Private Declare PtrSafe Function lstrcpy _
    Lib "kernel32.dll" Alias "lstrcpyA" ( _
    ByVal lpString1 As String, _
    ByVal lpString2 As Long) As LongPtr
Private Declare PtrSafe Function lstrlen _
    Lib "kernel32.dll" Alias "lstrlenA" ( _
    ByVal lpString As String) As Long
Private Declare PtrSafe 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
Private Declare PtrSafe Function WriteProfileString _
    Lib "kernel32" Alias "WriteProfileStringA" ( _
    ByVal lpszSection As String, _
    ByVal lpszKeyName As String, _
    ByVal lpszString As String) As Long
Private Declare PtrSafe Function SendNotifyMessage _
    Lib "user32" Alias "SendNotifyMessageA" ( _
    ByVal hwnd As Long, _
    ByVal msg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long
   
Private Const HWND_BROADCAST As Long = &HFFFF&
Private Const WM_WININICHANGE As Long = &H1A
Private Const PRINTER_ENUM_LOCAL = &H2
   
Sub 枚举系统打印机名称与端口()
    Dim pi5() As PRINTER_INFO_5, arr$()
    Dim pNeeded&, pReturned&, i&, p&
    Dim oPrinterName$, oPortName$
   
    ret = EnumPrinters(PRINTER_ENUM_LOCAL, _
        "", 5, 0, 0, pNeeded, pReturned)
    If pNeeded Then
        ReDim pi5(pNeeded)
        p = pNeeded
    Else
        Exit Sub
    End If
    If ret Then
        ReDim arr(0 To pReturned - 1, 1)
        For i = 0 To pReturned - 1
            oPrinterName = Space(lstrlen(pi5(i).pPrinterName))
            lstrcpy oPrinterName, pi5(i).pPrinterName
            oPortName = Space(lstrlen(pi5(i).pPortName))
            lstrcpy oPortName, pi5(i).pPortName
            arr(i, 0) = oPrinterName '名称
            arr(i, 1) = oPortName '端口
        Next
    End If
End Sub

Sub 获取与设置系统默认打印机()
    Dim p$, apName$
    p = String$(128, 0)
    GetProfileString "Windows", "Device", "", p, Len(p)
    '获取当前打印机//包含端口
    apName = Left(Trim(p), InStr(Trim(p), ",") - 1)

    Dim pName$
    pName = "HP LaserJet P1007" '指定默认打印机//可包含端口
    WriteProfileString "Windows", "Device", pName
    SendNotifyMessage HWND_BROADCAST, WM_WININICHANGE, 0, ByVal "Windows"
End Sub

cunfu2010

lss001 发表于 2025-4-3 09:00
'''如果WMI无法设置，可以试试WindowsAPI设置

Type PRINTER_INFO_5

感谢！受教了。我再看看其他