Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Excel VBA print to microsoft office document imagewrite, portnumber keeps changing (ne00

Posted on 2011-03-15
4
Medium Priority
?
816 Views
Last Modified: 2013-11-26
as many people i encoutered the fact that the activeport of the modi-printer keeps changing. Out there you find some solutions but my lack of programming knowledge prohibits me from getting it working correctly.

i want to print to tif file where the filename is in a cel And that it works regardless of the NE-port number.
so it should print to the MODI-printer and find out on what port it is and print/save the file as.......

Attached you find an example file i got it from an ealier post and hope someone can help me get it working. Below some examples of solutions that give an idea of what's the problem:
http://www.pcreview.co.uk/forums/vba-active-printer-port-problem-t3540182.html
https://support.automatedresults.net/KB/a79/generic-printing-in-excel-without-specifiing-ne-ports.aspx

gatenpatroon-module-v5.xlsm
0
Comment
Question by:mco_boonstra
  • 2
4 Comments
 
LVL 85

Accepted Solution

by:
Rory Archibald earned 2000 total points
ID: 35139013
Try this:
Sub export()
   Dim strPrinter As String
   strPrinter = "Microsoft Office Document Image Writer"
    Sheets("boorgat coordinaten").Select
    Range("A1:P58").Select
    Path = "f:\klant_tekening\"
    Filename = Range("h4").Value & "." & Range("I4").Value & ".1" & ".tif"
    ActiveWorkbook.PrintOut 1, 1, 1, False, strPrinter & " op " & GetPrinterPort(strPrinter), True, False, Path & Filename, False
 
End Sub
Public Function GetPrinterPort(strPrinterName As String) As String
    Dim objReg As Object, strRegVal As String, strValue As String
    Const HKEY_CURRENT_USER = &H80000001
    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    strRegVal = "Software\Microsoft\Windows NT\CurrentVersion\PrinterPorts\"
    objReg.getstringvalue HKEY_CURRENT_USER, strRegVal, strPrinterName, strValue
    GetPrinterPort = Mid$(strValue, 10, 5)
End Function

Open in new window

0
 
LVL 19

Expert Comment

by:Arno Koster
ID: 35139109
you could use the code from http://www.tek-tips.com/viewthread.cfm?qid=628174&page=8 to find out which printers are installed on your system.
It takes some tweaking to get it in a format you'd be looking for but it works.
In short, the upper function looks in the registry which NE port is linked to a specific printer name. The second function queries the registry for all known printer names and uses the getnewprinter function to combine these values.
As a proof of concept, the active printer is set and printed to the debug output for each printer.

succes !

Function GetNewPrinter(Printer As String) As String
'
' Get EXCEL printer name from windows printer name
' Input: printer name like "HP Laserjet"
' Output: printer name like "HP Laserjet at Ne02:"
'
Dim ws As Object
On Error GoTo ErrHandler

Set ws = CreateObject("WScript.Shell")
np = ws.regread("HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Devices\" & Printer)
If Len(np) >= 5 Then GetNewPrinter = Printer & " op " & Right(np, 5) Else GetNewPrinter = ""
Exit Function

ErrHandler:
GetNewPrinter = ""
End Function


Public Function ListAllPrinters() As String

   Dim lObj_ScriptControl        As IWshNetwork_Class
   Dim lCol_Printers             As IWshCollection_Class
   Dim lStr_PrinterList          As String
   Dim lInt_Idx                  As Integer
   
   Set lObj_ScriptControl = New IWshNetwork_Class
   Set lCol_Printers = lObj_ScriptControl.EnumPrinterConnections

   lStr_PrinterList = vbNullString
   For lInt_Idx = 1 To lCol_Printers.Count - 1 Step 2
      
      Debug.Print "Voor : " & Application.ActivePrinter
      new_printer = GetNewPrinter(lCol_Printers.Item(lInt_Idx))
      Application.ActivePrinter = new_printer
      Debug.Print "Na   : " & Application.ActivePrinter
      
      lStr_PrinterList = lStr_PrinterList & lCol_Printers.Item(lInt_Idx) & ";"
   Next lInt_Idx

   If (Right(lStr_PrinterList, 1) = ";") Then
      lStr_PrinterList = Left(lStr_PrinterList, Len(lStr_PrinterList) - 1)
   End If

   Set lObj_ScriptControl = Nothing
   Set lCol_Printers = Nothing
   
   ListAllPrinters = lStr_PrinterList

End Function

Open in new window

0
 
LVL 19

Expert Comment

by:Arno Koster
ID: 35139173
For the code to run, you have to add a reference to the "Windows Script Host Object Model"
0
 

Author Closing Comment

by:mco_boonstra
ID: 35139195
This solution was great, copy and paste and it works flawlessly.
And the responcetime was super.
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This article describes a serious pitfall that can happen when deleting shapes using VBA.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

782 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question