IE.ExecWB 6,2显示打印对话框。如何打印此页面?

时间:2017-12-20 14:57:05

标签: excel vba excel-vba

我正在尝试在浏览网页后打印PDF。 以下是代码:

Sub login()
Dim IE      As Object
Dim HTMLDoc As Object, HTMLDoc2 As Object
Dim objCollection As Object
Dim currentURL As String

Const navOpenInNewTab = &H800
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate "url"
Do While IE.Busy Or IE.ReadyState <> 4: Loop

Set HTMLDoc = IE.document
'Application.Wait (Now + TimeValue("00:0:10"))

With HTMLDoc
    HTMLDoc.getElementById("userName").Value = "ABC"    'Entering credential
    HTMLDoc.getElementById("password").Value = "xyz"
End With

Application.Wait (Now + TimeValue("00:0:3"))
Set objCollection = IE.document.getElementById("submitButton")
objCollection.Click

Do While IE.Busy Or IE.ReadyState <> 4: Loop    ' opening the second webpage

Set HTMLDoc2 = IE.document
With HTMLDoc2
    IE.Navigate "URL"

End With
Application.Wait (Now + TimeValue("00:0:10"))

Do While IE.Busy Or IE.ReadyState <> 4: Loop

Set objCollection = IE.document.getElementById("menu_print")
objCollection.Click

Do While IE.Busy Or IE.ReadyState <> 4: Loop
Application.Wait (Now + TimeValue("00:0:03"))

With CreateObject("Shell.Application").Windows
    If .Count > 0 Then
        ' Get IE
        Set IE = .Item(1)    ' or .Item(.Count - 1) 'second tab
        IE.Navigate "URL"    'third webpage
        IE.ExecWB 6, 2
        'Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint")
    End If
End With

End Sub

如何单击打印对话框上的打印按钮,或如何在不单击或处理对话框的情况下在第三个网页上打印PDF。是否有直接命令在网页上打印PDF。

添加了bleow代码以查找“打印”对话框 代码:

timeout = Now + TimeValue("00:00:04")
Do
hWnd = FindWindow(vbNullString, "Print") 'Finding the save as window
DoEvents
Sleep 200
Loop Until hWnd Or Now > timeout

  If hWnd Then

    SetForegroundWindow hWnd

    'Find the child DUIViewWndClassName window

   'hWnd = FindWindowEx(hWnd, 0, "DUIViewWndClassName", vbNullString)
    hWnd = FindWindowEx(hWnd, 0, "Button", "&Print") 'Finding the Print button on the window
    Sleep 600
  SendMessage hWnd, BM_CLICK, 0, 0

End If

代码能够找到“打印”对话框并将其设置在前台。 但是,它无法找到打印按钮。对于FindwindowEx,它将hWnd返回为零。

我的标题文件:

Option Explicit

Public Declare PtrSafe Sub Sleep Lib "kernel32" _
    (ByVal dwMilliseconds As Long)


Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare PtrSafe Function FindWindowEx Lib "user32" _
                                  Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, _
                                  ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr

Public Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, _
                                                           ByVal wParam As LongPtr, lParam As Any) As LongPtr

Public Declare PtrSafe Function SetForegroundWindow Lib "user32" _
    (ByVal hWnd As Long) As LongPtr


Public Declare PtrSafe Function SendMessageByString Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As LongPtr


Public Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" _
    (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPtr


Public Declare PtrSafe Sub keybd_event Lib "user32" _
    (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)



    Public Const BM_CLICK = &HF5
    Public Const WM_SETTEXT = &HC
    Public Const WM_GETTEXT = &HD
    Public Const WM_GETTEXTLENGTH = &HE

    Public Const VK_KEYDOWN = &H0
    Public Const VK_KEYUP = &H2
    Public Const VK_CONTROL = &H11

2 个答案:

答案 0 :(得分:1)

根据this post,第二个参数控制打印对话框的行为,因此:

IE.ExecWB 6, 1

应打印文档而不要求确认。

答案 1 :(得分:0)

示例应在调用ExecWB命令后单击打印按钮。你大部分都在那里。看起来您可能在调用API以及返回的数据方面存在问题(例如Long vs LongPtr)。我添加了一些条件编译条件,以根据平台指定正确的API调用。我有这个工作在我的端(运行32位Office)。

Option Explicit

Public Const BM_CLICK = &HF5

#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Public Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Public Declare PtrSafe Function FindWindowEx Lib "USER32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Public Declare PtrSafe Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Public Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Public Declare Function FindWindowEx Lib "USER32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Public Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#End If

Private Sub IEExample()
    Const readyState_Complete As Byte = 4
    Const printPage As Byte = 6
    Const dontPrompt = 1

    #If VBA7 Then
        Dim windowHWND As LongPtr
        Dim buttonHWND As LongPtr
    #Else
        Dim windowHWND As Long
        Dim buttonHWND As Long
    #End If

    With CreateObject("InternetExplorer.Application")
        .navigate "www.google.com"
        While .busy Or .readystate <> readyState_Complete: Wend
        .ExecWB printPage, dontPrompt
    End With

    windowHWND = getWindowPointer("Print", "#32770")

    If windowHWND > 0 Then
        'Add a small delay to allow the window to finish rendering if needed
        Sleep 250
        buttonHWND = FindWindowEx(windowHWND, 0, "Button", "&Print")
        If buttonHWND > 0 Then
            SendMessage buttonHWND, BM_CLICK, 0, 0
        Else
            Debug.Print "didn't find button!"
        End If
    End If

End Sub

Private Function getWindowPointer(WindowName As String, Optional ClassName As String = vbNullString) As Long
    Dim i As Byte

    #If VBA7 Then
        Dim hwnd As LongPtr
    #Else
        Dim hwnd As Long
    #End If

    'Wait for the window to exist then return the pointer
    For i = 1 To 100
        hwnd = FindWindow(ClassName, WindowName)
        If hwnd > 0 Then
            getWindowPointer = hwnd
            Exit For
        End If

        DoEvents
        Sleep 200
    Next

End Function