Speichern einer PDF nicht möglich .... Klicken Sie im Dialogfeld Speichern unter auf die Schaltfläche Speichern. VBA-Code

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 

Meine Erklärung in einem anderen Modul ist:

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 

ich gedebuggt und fand, dass ich bin in der Lage die gleiche Hwnd für Findwindow und FindWindowEx zu bekommen, aber die Sendmessage-Funktion einer Laufzeit gibt error453: Cant DLL Eingangspunkt finden SendMessage in User32

Answer 1

Vielleicht könnte ein Suchfenster funktionieren?

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 

EDIT: Das sollte funktionieren. Getestet in x64 2013, passend zu Ihren Bedürfnissen.

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 

In Ihrem Unter

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