AW: Probleme mit Webabfrage seit Internet Explorer 11
18.12.2013 22:25:19
Marcel
Hallo Martin
Danke erstmal für deine Antwort. Die erste Variante bringt mir irgendwie keine Lösung und bei der zweiten Variante bleibt der Code genau bei dem neuen Loop stehen und der Code geht nicht weiter.
Ich habe euch hier nachfolgend einmal den Code gepostet wie er in der Version 10 des IE läuft. In der Version 11 ist es egal was für ein Datum in das Feld eingebe, in welches ich das Datum auf der Homepage schreiben muss. Im IE 11 wird dann immer die Tabelle in Excel übernommen welche beim ersten aufruf der Website angezeigt wird. Wenn ich den geöffneten IE dann aber anschaue wird mir aber der gänderte Inhalt wie gewünscht angezeigt, aber nicht übernommen!
Hat jemand eine Idee woran das bei IE 11 liegen könnte? Wie gesagt bei IE 10 funktioniert der Code und bringt mir das gewünschte ergebnis!
Vielleicht hat mir auch noch jemand eine Idee wie ich die Funktion SendKeys welche ich in dem Code verwende ersetzten könnte! Mein Problem ist das ich irgendwie ein Enter an den IE senden muss da ich auf der Homepage das gewünschte Datum eingeben kann aber keine Schaltfläche habe sondern das Datum mit Enter abschicken muss damit die Homepage aktualisiert werden kann.
Danke bereits jetzt für eure Antworten
Gruss
Marcel
Public Sub Dienstdaten_aus_Internet()
Dim IEApp As Object
Dim IEApp2 As Object
Dim IEDocument As Object
Dim IEDocument1 As Object
Dim IEDocument2 As Object
Dim IEDocument3 As Object
Dim IEDocument4 As Object
Dim Monat As String
Dim Jahr As String
Dim wksStart As Worksheet
Dim wksIntZiel1 As Worksheet, wksIntZiel2 As Worksheet, wksIntZiel3 As Worksheet
Dim sSource As String, sTable As String
Dim IPosBeg As Long, IPosEnd As Long
Dim objData As DataObject
Dim w1 As Worksheet, w2 As Worksheet, w3 As Worksheet
Dim lngLetzteZeile As Long
Dim c As Range, d As Range, e As Range, f As Range, a As Range, b As Range
Monat = "01" 'valTextBox1
Jahr = 2014 'valTextBox2
varSuchen = "Haltiner Marcel" 'valComboBox1
'Start Arbeitsblatt "Eingabe Windows" setzen
Set wksStart = ThisWorkbook.Worksheets("Eingabe Windows")
'Auf InternetExplorer zugreifen
Set IEApp = CreateObject("InternetExplorer.Application")
IEApp.Visible = False
'Bedips Startseite aufrufen
IEApp.Navigate "http://www."
Do: Loop Until IEApp.Busy = False
Do: Loop Until IEApp.Busy = False
Set IEDocument1 = IEApp.Document
Do: Loop Until IEDocument1.ReadyState = "complete"
Do: Loop Until IEApp.Busy = False
'Mit Fahrernummer und Kennwort einloggen
IEDocument1.getElementByID("MainContent_txtLogin").Value = "abc"
IEDocument1.getElementByID("MainContent_txtPasswort").Value = "123"
IEDocument1.getElementByID("MainContent_Button1").Click
Set IEApp2 = CreateObject("InternetExplorer.Application")
'Internet-Seite "Diensteinteilung" aufrufen
IEApp2.Navigate "http://www."
IEApp2.Visible = True
Do: Loop Until IEApp2.Busy = False
Do: Loop Until IEApp2.Busy = False
Set IEDocument2 = IEApp2.Document
Do: Loop Until IEDocument2.ReadyState = "complete"
Do: Loop Until IEApp2.Busy = False
'Datum setzten für 1. des Monats
IEDocument2.getElementByID("txtAb").Value = "01." & Monat & "." & Jahr
IEDocument2.getElementByID("txtAb").Click
IEDocument2.getElementByID("txtAb").Focus
SendKeys "~", True
DoEvents
Set IEDocument2 = Nothing
Set IEDocument3 = IEApp2.Document
Do: Loop Until IEDocument3.ReadyState = "complete"
Do: Loop Until IEApp.Busy = False
'Linke Tabelle von Internet nach Excel übernehmen (Tabellenblatt "Diensteinteilung 1")
sSource = IEDocument3.DocumentElement.innerHTML
sSource = Replace(sSource, "
", "", , , vbTextCompare)
IPosBeg = InStr(1, sSource, "", vbTextCompare)
sTable = Mid(sSource, IPosBeg, (IPosEnd - IPosBeg - 1))
Set objData = New DataObject
objData.SetText ""
objData.PutInClipboard
objData.SetText sTable
objData.PutInClipboard
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Diensteinteilung 1"
ActiveSheet.Paste
For Each c In ActiveSheet.UsedRange
If c.MergeCells Then
With c.MergeArea
.UnMerge
.Clear
End With
End If
Next c
Set wksIntZiel1 = ThisWorkbook.Worksheets("Diensteinteilung 1")
lngLetzteZeile = wksIntZiel1.UsedRange.Rows.Count
'If wksIntZiel1.Cells(lngLetzteZeile, 1).Value = "" Then GoTo Next1
'Else: GoTo Nichtloeschen
'Letzte bestimmen
'Rechte Tabelle von Internet nach Excel übernehmen (Tabellenblatt "Diensteinteilung 4")
sSource = IEDocument3.DocumentElement.innerHTML
sSource = Replace(sSource, "
", "", , , vbTextCompare)
IPosBeg = InStr(1, sSource, "", vbTextCompare)
sTable = Mid(sSource, IPosBeg, (IPosEnd - IPosBeg - 1))
Set objData = New DataObject
objData.SetText ""
objData.PutInClipboard
objData.SetText sTable
objData.PutInClipboard
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Diensteinteilung 4"
ActiveSheet.Paste
For Each d In ActiveSheet.UsedRange
If d.MergeCells Then
With d.MergeArea
.UnMerge
.Clear
End With
End If
Next d
'Datum setzten für 11. des Monats
IEDocument3.getElementByID("txtAb").Value = "15." & Monat & "." & Jahr
IEDocument3.getElementByID("txtAb").Click
IEDocument3.getElementByID("txtAb").Focus
SendKeys "~", True
DoEvents
Set IEDocument3 = Nothing
Set IEDocument4 = IEApp2.Document
Do: Loop Until IEDocument4.ReadyState = "complete"
Do: Loop Until IEApp.Busy = False
'Linke Tabelle von Internet nach Excel übernehmen (Tabellenblatt "Diensteinteilung 2")
sSource = IEDocument4.DocumentElement.innerHTML
sSource = Replace(sSource, "
", "", , , vbTextCompare)
IPosBeg = InStr(1, sSource, "", vbTextCompare)
sTable = Mid(sSource, IPosBeg, (IPosEnd - IPosBeg - 1))
Set objData = New DataObject
objData.SetText ""
objData.PutInClipboard
objData.SetText sTable
objData.PutInClipboard
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Diensteinteilung 2"
ActiveSheet.Paste
For Each e In ActiveSheet.UsedRange
If e.MergeCells Then
With e.MergeArea
.UnMerge
.Clear
End With
End If
Next e
'Letzte bestimmen
'Rechte Tabelle von Internet nach Excel übernehmen (Tabellenblatt "Diensteinteilung 5")
sSource = IEDocument4.DocumentElement.innerHTML
sSource = Replace(sSource, "
", "", , , vbTextCompare)
IPosBeg = InStr(1, sSource, "", vbTextCompare)
sTable = Mid(sSource, IPosBeg, (IPosEnd - IPosBeg - 1))
Set objData = New DataObject
objData.SetText ""
objData.PutInClipboard
objData.SetText sTable
objData.PutInClipboard
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Diensteinteilung 5"
ActiveSheet.Paste
For Each f In ActiveSheet.UsedRange
If f.MergeCells Then
With f.MergeArea
.UnMerge
.Clear
End With
End If
Next f
If Not (GetKeyState(vbKeyNumlock) = 1) Then
keybd_event VK_NUMLOCK, 1, 0, 0
keybd_event VK_NUMLOCK, 1, KEYEVENTF_KEYUP, 0
End If
Call Dienste_zusammenführen
End Sub