Datenübergabe an Webformular

Sub BWPSchall() Dim IEApp As Object, oContent As Object Dim IEDocument As Object Dim strURL As String Dim StrasseMitHausnr As String Set IEApp = CreateObject("InternetExplorer.Application") IEApp.Visible = True IEApp.navigate "https://www.waermepumpe.de/normen-technik/schallrechner/" Do: Loop Until IEApp.Busy = False Set IEDocument = IEApp.Document Do On Error Resume Next Set oContent = IEDocument.getElementByid("content") Loop Until Err.Number = 0 On Error GoTo 0 With IEDocument .getElementByid("hersteller").Focus .getElementByid("hersteller").Value = Worksheets("Tabelle1").Range("D2") End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Hugo,
hier mal eine Anregung, wie Du das umsetzen könntest:
Falls etwas nicht passen sollte, kannst Du es nach diesem Muster ja anpassen.
Für den Hersteller ist der Index einzugeben, also 0 für den ersten Eintrag aus der DropDown-Liste usw.


[+][-] 
Sub BWPSchall()
  Dim IEApp As Object, oContent As Object
  Dim IEDocument As Object
  Dim strURL As String
  Dim StrasseMitHausnr As String, i As Integer
  Dim WSh As Worksheet
  
  Set WSh = Sheets("Tabelle1")
  
  Set IEApp = CreateObject("InternetExplorer.Application")
  IEApp.Visible = True
  IEApp.navigate "https://www.waermepumpe.de/normen-technik/schallrechner/"
  Do: Loop Until IEApp.Busy = False
  Set IEDocument = IEApp.document
  
  Do
    On Error Resume Next
    Set oContent = IEDocument.getElementById("content")
  Loop Until Err.Number = 0
  
  On Error GoTo 0
  
  With IEDocument
    .getElementById("hersteller").Focus
    .getElementById("hersteller").value = Worksheets("Tabelle3").Range("D2")
    On Error Resume Next
    
    .getElementsByClassName("gross")(0).value = WSh.Cells(2, "A").value  'Hersteller
    .getElementsByClassName("gross")(1).value = WSh.Cells(3, "A").value  'Modell
    .getElementsByClassName("klein1")(0).value = WSh.Cells(4, "A").value 'Leistung
    .getElementsByClassName("klein1")(1).value = WSh.Cells(5, "A").value 'Leistung LWA
    .getElementsByClassName("klein1")(2).value = WSh.Cells(6, "A").value 'Leistung Max
    .getElementsByClassName("klein1")(3).value = WSh.Cells(7, "A").value 'Leistung Nacht
    .getElementsByClassName("klein1")(4).value = WSh.Cells(8, "A").value 'Distanz
    .getElementsByClassName("klein1")(5).value = WSh.Cells(8, "A").value 'PLZ
   
  End With
End Sub

viele Grüße aus Freigericht
Karl-Heinz

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread