Solved

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

Posted on 2011-03-15
4
783 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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Suggested Solutions

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

757 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now