简体   繁体   中英

Selecting printer in excel VBA

When trying to print out on a specific printer in excel, it gives an error message when the server changes its' prompt. When trying to fix this, I used the "on error resume next" function, but that is just ugly (and does not work all the time).

This is my current formula

    Application.ScreenUpdating = False
ActivePrinter = "\\w8vvmprint01\Moecombi04 op Ne01:"
On Error Resume Next
ActivePrinter = "\\w8vvmprint01\Moecombi04 op Ne02:"
On Error Resume Next
ActivePrinter = "\\w8vvmprint01\Moecombi04 op Ne03:"
On Error Resume Next
ActivePrinter = "\\w8vvmprint01\Moecombi04 op Ne04:"
On Error Resume Next
ActivePrinter = "\\w8vvmprint01\Moecombi04 op Ne05:"
On Error Resume Next
ActivePrinter = "\\w8vvmprint01\Moecombi04 op Ne06:"
On Error Resume Next
ActivePrinter = "\\w8vvmprint01\Moecombi04 op Ne07:"
On Error Resume Next
ActivePrinter = "\\w8vvmprint01\Moecombi04 op Ne08:"
On Error Resume Next

What can I do to fix this?

#If VBA7 Then
Private Declare PtrSafe Function GetProfileString Lib "kernel32.dll" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
#Else
Private Declare Function GetProfileString Lib "kernel32.dll" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
#End If
Public Function GetPrinterPort(ByVal PrinterName As String) As String
  Dim t As Long

  Do
    GetPrinterPort = String$(Len(GetPrinterPort) + 256, 0)
    t = GetProfileString("PrinterPorts", PrinterName, "", GetPrinterPort, Len(GetPrinterPort))
  Loop Until t < Len(GetPrinterPort) - 1

  If t <= 0 Then Err.Raise 5, , "Cannot get printer port for " & PrinterName

  GetPrinterPort = Split(Left$(GetPrinterPort, t), ",")(1)
End Function

Usage:

port = GetPrinterPort("\\w8vvmprint01\Moecombi04")

Then use port to build the complete printer name. You might want to respect localization issues .

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM