Combine two working macros into one for MS Word 1

[remeng]

I have two working macros that I'd like to combine into one. The reason for this is because while they both print out the Word document, they do it differently.

Macro One pulls the Mail Merge data into the Word document correctly but will only print to the selected / default printer.

Macro Two allows for a selection of a printer by an IP address and the document to print to the defined printer. It does not process the mail merge.

The goal is a user to start macro 1 to update the mail merge data and macro 2 to send it to a printer based on the IP. How can I join these two together?

Thanks for the help!

Macro 1

Sub label_query_to_print(data_query_to_print, excelPath, printer_id_value, ip_address_value)

Debug.Print "Data Query: " & data_query_to_print
Debug.Print "Excel Pathway: " & excelPath
Debug.Print "IP Address: " & ip_address_value
Debug.Print "Printer ID: " & printer_id_value


    ActiveDocument.MailMerge.OpenDataSource Name:= _
        excelPath _
        , ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
        WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
        Format:=wdOpenFormatAuto, Connection:= _
        "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source" & excelPath & ";Mode=Read;Extended Properties=""HDR=YES" _
        , SQLStatement:=data_query_to_print, SQLStatement1:="", _
        SubType:=wdMergeSubTypeAccess
    With ActiveDocument.MailMerge
        .Destination = wdSendToPrinter
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With


End Sub

Macro 2

Sub PrintToPrinterByIP()
    Dim strPrinterIP As String
    Dim objWMIService As Object
    Dim colPrinters As Object
    Dim objPrinter As Object
    Dim foundPrinter As Boolean
    
    ' Define the IP address of the printer (you can change this)
    strPrinterIP = "172.16.209.36"  ' Replace with your desired printer IP address
    
    ' Flag to check if the printer is found
    foundPrinter = False
    
    ' Get the WMI service to query printers
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    
    ' Query to get all installed printers
    Set colPrinters = objWMIService.ExecQuery("SELECT * FROM Win32_Printer")
    
    ' Loop through all printers found
    For Each objPrinter In colPrinters
        ' Check if the printer's port contains the desired IP address
        If InStr(objPrinter.PortName, strPrinterIP) > 0 Then
            ' If found, set the active printer and print
            Application.ActivePrinter = objPrinter.Name
            ActiveDocument.PrintOut
            MsgBox "Document sent to printer at IP address: " & strPrinterIP
            foundPrinter = True
            Exit For
        End If
    Next objPrinter
    
    ' If no printer was found
    If Not foundPrinter Then
        MsgBox "No printer found with IP address: " & strPrinterIP
    End If
End Sub

 

[Andrzejek]

How can I join these two together?

Do you mean something like this:

Sub RunBothMacros()
    Call label_query_to_print(pass your attr here)
    Call PrintToPrinterByIP
End Sub

or, do you want to use anything that label_query_to_print sets/gets to pass to your PrintToPrinterByIP ?

 

[remeng]

Hi Andy,

I have info coming into the Sub label_query_to_print(data_query_to_print, excelPath, printer_id_value, ip_address_value) macro.

That includes the IP address of the printer (ip_address_value).

I need the Macro 1 to include the Macro 2 code that takes the IP address and sends the mail merge to the IP specific printer.

Currently, macro 1 will print the mail merge, but only to the default printer for Windows.

Macro 2 is a way to select a different printer by its IP address and send the document to a printer that is not set as the Windows default printer. Currently, it will print a document to the IP printer, but it doesn't work with the mail merge.

The goal is to have a user press a button to launch the mail merge (macro 1) and print to a specific printer based on its IP address (macro 2).

The reason for this is that the Mail Merge needs to go to label printers with spools of labels and not a standard 8.5" x 11" which is set as the computer's default. The users cannot spend time changing spool printers due to the total number of Mail Merges that need to take place. Basically, automation.

 

[Andrzejek]

With your:

With ActiveDocument.MailMerge
        .Destination = wdSendToPrinter

Other options for Destination are:

Name	Value	Description
wdSendToEmail	2	Send results to email recipient.
wdSendToFax	3	Send results to fax recipient.
wdSendToNewDocument	0	Send results to a new Word document.
wdSendToPrinter	1	Send results to a printer.

So, I don't know is there is a way to send it to the IP Address of a Printer.

I am sure some more knowledgeable people will respond...

 

[Andrzejek]

Based on this place: How do I change default printers in VBA, you can change default printer, print, and change it back to whatever printer was there to start with:

Sub label_query_to_print(data_query_to_print, excelPath, printer_id_value, ip_address_value)

Dim prt As Printer

Debug.Print "Data Query: " & data_query_to_print
Debug.Print "Excel Pathway: " & excelPath
Debug.Print "IP Address: " & ip_address_value
Debug.Print "Printer ID: " & printer_id_value

    With ActiveDocument.MailMerge
        .OpenDataSource Name:= excelPath _
        , ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
        WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
        Format:=wdOpenFormatAuto, Connection:= _
        "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source" & excelPath & ";Mode=Read;Extended Properties=""HDR=YES" _
        , SQLStatement:=data_query_to_print, SQLStatement1:="", _
        SubType:=wdMergeSubTypeAccess

' Get current default printer
Set prt = Application.Printer
' Set default printer
Application.Printer = Application.Printers(PrintToPrinterByIP(ip_address_value))

        .Destination = wdSendToPrinter
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With

' Restore original printer
Set Application.Printer = prt

End Sub

Function PrintToPrinterByIP(ByRef strPrinterIP As String) As String
    'Dim strPrinterIP As String
    Dim objWMIService As Object
    Dim colPrinters As Object
    Dim objPrinter As Object
    Dim foundPrinter As Boolean
    
    ' Define the IP address of the printer (you can change this)
    strPrinterIP = "172.16.209.36"  ' Replace with your desired printer IP address
    
    ' Flag to check if the printer is found
    'foundPrinter = False 'Not needed, by default is False
    
    ' Get the WMI service to query printers
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    
    ' Query to get all installed printers
    Set colPrinters = objWMIService.ExecQuery("SELECT * FROM Win32_Printer")
    
    ' Loop through all printers found
    For Each objPrinter In colPrinters
        ' Check if the printer's port contains the desired IP address
        If InStr(objPrinter.PortName, strPrinterIP) > 0 Then
            ' If found, set the active printer ''and print - not
            PrintToPrinterByIP = objPrinter.Name
            'ActiveDocument.PrintOut
            'MsgBox "Document sent to printer at IP address: " & strPrinterIP
            foundPrinter = True
            Exit For
        End If
    Next objPrinter
    
    ' If no printer was found
    If Not foundPrinter Then
        MsgBox "No printer found with IP address: " & strPrinterIP
    End If
End Sub

 

[strongm]

Retaining as much of your code as possible:

Option Explicit

Sub label_query_to_print(data_query_to_print, excelPath, printer_id_value, ip_address_value As String)

Debug.Print "Data Query: " & data_query_to_print
Debug.Print "Excel Pathway: " & excelPath
Debug.Print "IP Address: " & ip_address_value
Debug.Print "Printer ID: " & printer_id_value

  
    ActiveDocument.MailMerge.OpenDataSource Name:= _
        excelPath _
        , ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
        WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
        Format:=wdOpenFormatAuto, Connection:= _
        "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source" & excelPath & ";Mode=Read;Extended Properties=""HDR=YES" _
        , SQLStatement:=data_query_to_print, SQLStatement1:="", _
        SubType:=wdMergeSubTypeAccess
    
     PrintToPrinterByIP ip_address_value ' select active printer by IP address

    With ActiveDocument.MailMerge
        .Destination = wdSendToPrinter
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
    MsgBox "Mailmerge sent to printer at IP address: " & ip_address_value
End Sub

Sub PrintToPrinterByIP(strPrinterIP As String)
    'Dim strPrinterIP As String
    Dim objWMIService As Object
    Dim colPrinters As Object
    Dim objPrinter As Object
    Dim foundPrinter As Boolean
    
    ' Define the IP address of the printer (you can change this)
    'strPrinterIP = "172.16.209.36"  ' Replace with your desired printer IP address
    
    ' Flag to check if the printer is found
    foundPrinter = False
    
    ' Get the WMI service to query printers
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    
    ' Query to get all installed printers
    Set colPrinters = objWMIService.ExecQuery("SELECT * FROM Win32_Printer")
    
    ' Loop through all printers found
    For Each objPrinter In colPrinters
        ' Check if the printer's port contains the desired IP address
        If InStr(objPrinter.PortName, strPrinterIP) > 0 Then
            ' If found, set the active printer
            Application.ActivePrinter = FindPrinter(objPrinter.Name) ' Generally need full name including the network port
            foundPrinter = True
            Exit For
        End If
    Next objPrinter
    
    ' If no printer was found
    If Not foundPrinter Then
        MsgBox "No printer found with IP address: " & strPrinterIP
    End If
End Sub


' Didn't have time to write my own version of this,
' so credit to FaneDuru on StackExchange for the following function
Function FindPrinter(ByVal PrinterName As String) As String
  Dim arrH, Pr, Printers, Printer As String
  Dim RegObj As Object, RegValue As String
  Const HKEY_CURRENT_USER = &H80000001
      
    Set RegObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    RegObj.Enumvalues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Printers, arrH
    
      For Each Pr In Printers
        RegObj.getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Pr, RegValue
        Printer = Pr & " on " & Split(RegValue, ",")(1)
        If InStr(1, Printer, PrinterName, vbTextCompare) > 0 Then
           FindPrinter = Printer
           Exit Function
        End If
      Next
End Function

 

[remeng]

Strongm,

Thank you! That did it once I made some minor tweaks to the variable names.

When I tried to create my code, I was avoiding the regedit. I guess you just can't do it without the RegObj.

Later on, I'll dig into the code further to learn how it actually works.

Thanks again!

Mike

 

[strongm]

>regedit
I wouldn't worry too much - you are simply reading a few values