Question

My Code:

    Sub login()
          Dim IE As Object
          Dim HTMLDoc As Object, HTMLDoc2 As Object, HTMLDoc3 As Object, HTMLDoc4 As Object, HTMLDoc5 As Object
          Dim objCollection As Object
          Dim intChoice As Integer
          Dim strPath As String

          Const navOpenInNewTab = &H800
          Set IE = CreateObject("InternetExplorer.Application")
          IE.Visible = True
          IE.Navigate "https://www.abcd.com/CWRWeb/displayMemberLogin.do"
    ...............

    Do While IE.Busy Or IE.ReadyState <> 4: Loop
          Application.Wait (Now + TimeValue("00:0:03"))
          IE.Navigate "https://www.abcd.com/CWRWeb/OnlineStmtResultsPremDis.do" 'Final PDF
          Application.Wait (Now + TimeValue("00:0:03"))
          Set HTMLDoc5 = IE.document
                Application.SendKeys "+^{S}" 'Save Key ShortCut
      Application.Wait (Now + TimeValue("00:0:03"))

      'Finding the Save As Dialog Box

      timeout = Now + TimeValue("00:00:30")
      Do
      hWnd = FindWindow(vbNullString, "Save As")
      DoEvents
      Sleep 200
      Loop Until hWnd Or Now > timeout


      If hWnd Then
      hWnd = FindWindowEx(hWnd, 0, "Button", "&Save")
      End If

      If hWnd Then
      SetForegroundWindow (hWnd)
      Sleep 600
      SendMessage hWnd, BM_CLICK, 0, 0
      End If

      End Sub

我在另一个模块中的声明是：

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 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" (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

我调试并发现我能够为FindWindow和FindWindowEx获得相同的Hwnd，但SendMessage函数给出了运行时错误453：无法在User32中找到DLL入口点SendMessage

Answer 1

也许查找窗口可以工作？

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 'Declare this at the top of the module!

... your routine until the save as dialog is shown
Call iDetectScreen("Save As","Save As not found!")
... After detection what should do (Personally I'd do a send keys Enter)
...
Sub iDetectScreen(iScreen As String, iWriteErr As Integer)
Do Until lHnd1 > 0
    lHnd1 = FindWindow(vbNullString, iScreen)
    If i < 5 Then
    Application.Wait (Now() + TimeValue("00:00:01"))
    i = i + 1
    Else
    msgbox iWriteErr,vbCritical
    'window save didn't show 5 secs after supposed to
End Sub

<强> 编辑： 这应该工作。在x64 2013中测试，符合您的需求。

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 'Declare this at the top of the module!
 Sub iDetectScreen(iScreen As String, iWriteErr As String)
Do Until lHnd1 > 0
    lHnd1 = FindWindow(vbNullString, iScreen)
    If i < 5 Then
    Application.Wait (Now() + TimeValue("00:00:01"))
    i = i + 1
    Else
    MsgBox iWriteErr, vbCritical
    Exit Sub
    'window save didn't show 5 secs after supposed to
    End If
    Loop
End Sub
Sub SendEnter()
Call iDetectScreen("Save As", "Save As not found!")
AppActivate "Save As"
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys ("~")
End Sub

在您的子

中

...
Set HTMLDoc5 = IE.document
                Application.SendKeys "+^{S}" 'Save Key ShortCut
call SendEnter
...

无法保存PDF ....单击“另存为”对话框的“保存”按钮。 VBA代码

1 个答案: