So gehts
21.09.2018 11:29:01
Zwenn
Hallo zusammen,
nachdem dieser Thread nun schon für einen anderen Zweck gekapert wurde, habe ich mich jetzt mit Sendkeys beschäftigt. Man muss die Anwendung zuerst aktivieren, dann Sendkeys einsetzen. Hier geht es um einen Download im IE. Besteht bereits eine Datei mit gleichem Namen im Downloadordner, wird eine weitere angelegt und mit dem Zusatz (1) versehen.
Option Explicit
Sub CSVmitSendkeysSpeichern()
Dim browser As Object
Dim url As String
Dim knotenInput As Object
Dim knotenDownload As Object
Dim objShell As Object
Dim win As Object
'URL setzen
url = "https://www.ariva.de/allianz-aktie/historische_kurse"
'Seite im IE öffnen
Set browser = CreateObject("internetexplorer.application")
browser.Visible = True
browser.navigate url
Do Until browser.readyState = 4: DoEvents: Loop
'Grenzen für Daten setzen
browser.Document.getElementById("minTime").Value = "20.09.2015"
browser.Document.getElementById("maxTime").Value = "20.09.2018"
'Download Button klicken
'Alle Input Elemente einsammeln
Set knotenInput = browser.Document.getElementsByClassName("submitButton")
'Alle Input Elemente durchgehen auf das Attribut 'Download'
For Each knotenDownload In knotenInput
'Prüfen auf Attribut value mit dem Wert download
If knotenDownload.getAttribute("value") = "Download" Then
'Wenn Download Button gefunden, anklicken
knotenDownload.Click
'Zeit geben, um die DOwnloadleiste unten einzublenden
'(Muss eventuell angepasst werden, falls zu kurz)
Application.Wait (Now + TimeSerial(0, 0, 2))
Exit For
End If
Next knotenDownload
'CSV in den Standard-Download-Ordner laden
'Das ist der Download-Ordner des Systems
'Um Sendkeys richtig zu nutzen, muss die
'Application, an die gesendet werden soll
'aktiviert werden.
'Das passiert über den Namen in der Titelzeile
'Diesen kann man finden, indem man über die
'Shell alle offenen Fenster durchgeht und
'zunächst nach der Anwendung sucht, also dem
'Internet Explorer und dann schaut, ob die
'richtige URL darin geöffnet ist
Set objShell = CreateObject("Shell.Application")
For Each win In objShell.Windows
If InStr(1, UCase(win.FullName), "IEXPLORE") > 0 Then
If win.Document.Location = url Then
AppActivate win.Document.Title
Application.SendKeys ("%{S}")
End If
End If
Next
'Zeit für den Download geben, bevor der IE geschlossen wird
'(Muss eventuell angepasst werden, falls zu kurz)
Application.Wait (Now + TimeSerial(0, 0, 2))
'Aufräumen
browser.Quit
Set browser = Nothing
Set knotenInput = Nothing
Set knotenDownload = Nothing
End Sub
Viele Grüße,
Zwenn
