Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

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

Posted on 2011-03-15
4
792 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 500 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:akoster
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:akoster
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

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

839 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