Print to .XPS with the printer "Microsoft XPS Document Write"

[megatronixs]

Hi all,

I wanted to re-use some code that I have from Excel to print out a website to .xps with vba.

the below part of the code will use the xps printer. it uses in excel the value of a cell to create the file name. in the access database i should use the field "LE_Name":

    Application.ActivePrinter = "Microsoft XPS Document Writer on ne01:" 
     
     '// Do you really want preview? Changed to False here to test actual file creation
    Sheets("Results").Range("A1:R" & LastRow).PrintOut _ 
    copies:=1, _ 
    Collate:=True, _ 
    PrintToFile:=True, _ 
    PrToFileName:=PrintTo & (Sheets("Results").Range("B2").Value & ".xps"), _ 
    Preview:=False, _ 
    ActivePrinter:="Microsoft XPS Document Writer on ne01:"

I made those changes, but it breaks on the

Application.ActivePrinter = "Microsoft XPS Document Writer on

and again at the end

ActivePrinter:="Microsoft XPS Document Writer on ne01:"

I know that there is no active printer in the access vba, but have now clue how to solve the above.


"PrintTo" is where it gets the path name from.
Greetings.

 

[MarkK]

The Application.ActivePrinter is a Printer object, not a string, so to find one by string matching, and then assign it to ActivePrinter, you might use code like . . .

private m_p as printer

private sub Form_Load()
[COLOR="Green"]'  when this form loads the ActivePrinter is changed
'  to the XPS printer, if it exists
[/COLOR]   dim p as printer

   set m_p = application.activeprinter [COLOR="Green"]'save the previous printer[/COLOR]
   set p = GetXPSPrinter               [COLOR="Green"]'get the XPS printer[/COLOR]
   if not p is nothing then set application.activeprinter = p [COLOR="Green"]'set ActivePrinter[/COLOR]
end sub

private sub form_close()
[COLOR="Green"]'  when this form closes the activeprinter is set back
'  to what it was before the form opened
[/COLOR]   set application.activeprinter = m_p
end sub

Function GetXPSPrinter as Printer
[COLOR="Green"]'   this function returns the first printer object with a DeviceName that
'   includes the string 'Microsoft XPS', if it exists, or nothing
[/COLOR]   dim p as printer
   for each printer in application.printers
      if instr(p.devicename, "Microsoft XPS") then 
         set GetXPSPrinter = p
         exit for
      end if
   next
End Function

See what's going on there?

 

[megatronixs]

Hi MarkK,

I managed to find out about the printer, but the code I used in Excel is not compatible with Access and I cant re-use it all.
I used the below code to go to goople page and print the website. The only thing is that I have to imput the folder name and the file name for each one. I would like it to print it out to .xps format with a given folder name and file name without the need to click and type on each one.
The below code is the one I have now:

Option Compare Database
Option Explicit
Sub btn_google_searches_Click()
Dim ie As Object
Dim db As DAO.Database
Set db = CurrentDb
Dim rs As DAO.Recordset
Set rs = db.OpenRecordset("SELECT * FROM tbl_google_searches", dbOpenDynaset)
rs.MoveFirst
Do Until rs.EOF
'Debug.Print "Search For: " & rs!Search_For 'Shows value of active record from ID field in Immediate Window
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
        MsgBox "You go now to the first page web search"
    ie.Navigate "[URL="http://www.google.com/"][COLOR=#0066cc]http://www.google.com[/COLOR][/URL]" & "/" & "search?q=" & rs!Search_For & "&start=0"
        Do While ie.Busy: DoEvents: Loop
        Do While ie.ReadyState <> 4: DoEvents: Loop
ie.ExecWB 6, 2
        MsgBox "You go now to the second page web search"
    ie.Navigate "[URL="http://www.google.com/"][COLOR=#0066cc]http://www.google.com[/COLOR][/URL]" & "/" & "search?q=" & rs!Search_For & "&start=10"
        Do While ie.Busy: DoEvents: Loop
        Do While ie.ReadyState <> 4: DoEvents: Loop
ie.ExecWB 6, 2
        MsgBox "You go now to the first page news search"
    ie.Navigate "[URL="http://www.google.com/"][COLOR=#0066cc]http://www.google.com[/COLOR][/URL]" & "/" & "search?q=" & rs!Search_For & "&tbm=nws&start=0"
        Do While ie.Busy: DoEvents: Loop
        Do While ie.ReadyState <> 4: DoEvents: Loop
ie.ExecWB 6, 2
        MsgBox "You go now to the second page news search"
    ie.Navigate "[URL="http://www.google.com/"][COLOR=#0066cc]http://www.google.com[/COLOR][/URL]" & "/" & "search?q=" & rs!Search_For & "&tbm=nws&start=10"
        Do While ie.Busy: DoEvents: Loop
        Do While ie.ReadyState <> 4: DoEvents: Loop
ie.ExecWB 6, 2
MsgBox "This is the end of your Google searches mi amigo!"
rs.MoveNext 'Move to the next record
Loop
rs.Close 'Close recordset when you are done.
End Sub

This is some code that I use in Excel to print the files to .xps format without user input:

Private Sub Export_to_XPS_Click()          Dim LastRow          As Long     Dim PrintTo          As String           '// Ensure triling '\' and that the path is relative to the remote machine    PrintTo = "C:\documents\proof\"           '// Check if the default directory exists - if not user     '// is prompted to select a directory. Cancelling selection     '// will cancel the print    If Not GetDestDir(PrintTo) Then         Exit Sub     End If           '// Make sure trailing '\' exists.    If Right(PrintTo, 1) <> "\" Then PrintTo = PrintTo & "\"          LastRow = Sheets("Results").Cells(60000, 1).End(xlUp).Row           '// Mine shows on ne01...    Application.ActivePrinter = "Microsoft XPS Document Writer on ne01:"           '// Do you really want preview? Changed to False here to test actual file creation    Sheets("Results").Range("A1:R" & LastRow).PrintOut _     copies:=1, _     Collate:=True, _     PrintToFile:=True, _     PrToFileName:=PrintTo & (Sheets("Results").Range("B2").Value & ".xps"), _     Preview:=False, _     ActivePrinter:="Microsoft XPS Document Writer on ne01:"      End Sub  Private Function GetDestDir(ByRef strDefault As String) As Boolean          Dim fldr             As FileDialog     Dim sItem            As String           '// The default directory exists - exit    If Dir(strDefault, vbDirectory) <> vbNullString Then GetDestDir = True: Exit Function          Set fldr = Application.FileDialog(msoFileDialogFolderPicker)          With fldr         .Title = "Select Output folder"         .AllowMultiSelect = False         .InitialFileName = CreateObject("WScript.Shell").SpecialFolders("MyDocuments")                  If .Show = True Then             strDefault = .SelectedItems(1)             GetDestDir = True         End If              End With          Set fldr = Nothing      End Function

I really hope I can print to the .xps

Greetings.

 

[MarkK]

I don't understand the problem. Does the code I posted fail to change the Application.ActivePrinter? How have you integrated the code I posted into your solution? I don't see where any of the code you posted sets a printer or prints a file.

 

[megatronixs]

Hi MarkK,

I wanted to print out the website with the xps printer giving it a file name and the folder where it should go.
I can print out a excel sheet range, but the website is like impossible.
In my below code example, I can print a range from excel:

Private Sub Export_to_XPS_Click() 
     
    Dim LastRow          As Long 
    Dim PrintTo          As String 
     
     '// Ensure triling '\' and that the path is relative to the remote machine
    PrintTo = "C:\documents\proof\" 
     
     '// Check if the default directory exists - if not user
     '// is prompted to select a directory. Cancelling selection
     '// will cancel the print
    If Not GetDestDir(PrintTo) Then 
        Exit Sub 
    End If 
     
     '// Make sure trailing '\' exists.
    If Right(PrintTo, 1) <> "\" Then PrintTo = PrintTo & "\" 
     
    LastRow = Sheets("Results").Cells(60000, 1).End(xlUp).Row 
     
     '// Mine shows on ne01...
    Application.ActivePrinter = "Microsoft XPS Document Writer on ne01:" 
     
     '// Do you really want preview? Changed to False here to test actual file creation
    Sheets("Results").Range("A1:R" & LastRow).PrintOut _ 
    copies:=1, _ 
    Collate:=True, _ 
    PrintToFile:=True, _ 
    PrToFileName:=PrintTo & (Sheets("Results").Range("B2").Value & ".xps"), _ 
    Preview:=False, _ 
    ActivePrinter:="Microsoft XPS Document Writer on ne01:" 
     
End Sub 
 
Private Function GetDestDir(ByRef strDefault As String) As Boolean 
     
    Dim fldr             As FileDialog 
    Dim sItem            As String 
     
     '// The default directory exists - exit
    If Dir(strDefault, vbDirectory) <> vbNullString Then GetDestDir = True: Exit Function 
     
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker) 
     
    With fldr 
        .Title = "Select Output folder" 
        .AllowMultiSelect = False 
        .InitialFileName = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") 
         
        If .Show = True Then 
            strDefault = .SelectedItems(1) 
            GetDestDir = True 
        End If 
         
    End With 
     
    Set fldr = Nothing 
     
End Function

I want to the same, but then for the website.
As you can see from the post nr. 1 there is code to open google searches and then to print them out, the only thing is that I have to manually add every time the file name and location.

There must be some way to pass this also via vba in Access.

Greetings.

 

[MarkK]

I'm still not sure I understand, but if you want to print a range of cells from Excel, you use a method exposed by the Excel object model. Similarly, I would expect that to print a website you need to use a method exposed by the "InternetExplorer.Application" object you've created. Is that what you mean?

Or are you looking for a way to return a string from your GetDestDir() function?

Or are you looking for a way to loop thru the first four pages of results?

Sorry, I don't understand.

 

[megatronixs]

Hi MarkK,

I want to print out to xps the webpage.
The first macro in access vba will loop trough a table where I put some names I want t check in google. for each name, the code goes to the first page of google, then it should print it out to xps file, then goes to second page in google and print that page too. The second part goes to the news section of google and again prints out page one and two.
As you can see from the access code, there is a message box poping up to kind of pauze the code and the user has time to enter the file name and location and press the button to save it to xps file.
In the code from excel, there is no need to press the save button or enter file name in the dialog box. And that is what I would like to do with it, automaticly press the button and enter file name and path.

Greetings.

 

[MarkK]

Printing is handled by the application that hosts the object in question, so in Access, to print, you would use a Report, and you would print it using DoCmd.OpenReport. In Excel, your code leverages the Excel.Range.PrintOut method. To print a webpage, you need to explore the methods exposed by the object created here in your code . . .

    Set ie = CreateObject("InternetExplorer.Application")

To explore this object model in greater detail, you can set a reference to an object model called 'Microsoft Internet Controls', and on my computer it appears in the list of references available to set from a code window. The file is called 'ieframe.dll' and it's in my Windows\System32 folder. Then, explore the object model to 'ShDocVw' in your object browser and see what kind of printing methods it exposes.
Hope this helps,

 

[megatronixs]

Hi MarkK,

It is very complicated with the IE as it has this silly thing that you can't avoid those messages boxes.
will try your tip and see how far I get.
If I manage to solve this, I will share it so others can make use of it too.

Greetings.