per Makro zwei Daten von Inetseite auslesen

Hallo an euch alle,
wolle mal fragen, da ich gelesen habe dass Excel Makros auf Internetseiten zugreifen können ob folgendes möglich ist.
1. Ich schreibe einen Text in Spalte B. (in meinem Beispiel nm0000722)
2. Das Makro soll dann automatisch ohne dass ich etwas zusätzlich mache, die Seite https://www.imdb.com/name/nm0000722/ öffnen.
3. Es soll den fett geschriebenen Namen des Schauspielers, im Beispiel Joss Ackland in Spalte C ausgeben.
4. Es soll den Geburtstag des Schauspielers in dem Fall February 29, 1928 in Spalte D ausgeben.
Da ich bereits eine Formel habe, die diesen Geburtstag in das Format 29.02.1928 bringt, braucht das Makro den Geburtstag nicht umzuwandeln.
Was jedoch passieren kann, wie z.B. auf der Seite https://www.imdb.com/name/nm6000000/ dass der Geburtstag unbekannt ist, dann soll halt kein Geburtstag in die Tabelle übertragen werden und auch keine Fehlermeldung darüber erscheinen.
ist das machbar?
Danke und Gruß
Christian

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim objIE As Object On Error GoTo ErrorHandler Application.EnableEvents = False If Target(1, 1).Column = 2 And Target(1, 1).Row > 1 Then Target(1, 1).Offset(0, 1) = "...wait" Set objIE = CreateObject("InternetExplorer.Application") With objIE .Navigate "https://www.imdb.com/name/" & Target(1, 1).Text & "/" Do While .Busy Or .readystate <> 4 DoEvents Loop Target(1, 1).Offset(0, 1) = .Document.getElementsByClassName("itemprop")(0).innerText Target(1, 1).Offset(0, 2) = .Document.getElementsByTagName("time")(0).innerText .Quit End With If Target(1, 1).Offset(0, 1) = "...wait" Then Target(1, 1).Offset(0, 1) = "no data" End If ErrorHandler: Application.EnableEvents = True Set objIE = Nothing End Sub VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Private Sub Worksheet_Change(ByVal Target As Range) Dim objIE As Object On Error GoTo ErrorHandler Application.EnableEvents = False With Target(1, 1) If .Column = 2 Then If .Value = "" Then .Resize(, 3).ClearContents Else .Offset(0, 1) = "...wait" Set objIE = CreateObject("InternetExplorer.Application") objIE.Navigate "https://www.imdb.com/name/" & .Text & "/" Do While objIE.Busy Or objIE.readystate <> 4 DoEvents Loop On Error Resume Next .Offset(0, 1) = objIE.Document.getElementsByClassName("itemprop")(0).innerText .Offset(0, 2) = objIE.Document.getElementsByTagName("time")(0).innerText objIE.Quit Err.Clear On Error GoTo ErrorHandler If .Offset(0, 1) = "...wait" Then .Offset(0, 1) = "no data" End If End If End With ErrorHandler: Application.EnableEvents = True Set objIE = Nothing End Sub VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim objIE As Object On Error GoTo ErrorHandler Application.EnableEvents = False With Target(1, 1) If .Column = 2 And .Row > 1 Then If .Value = "" Then .Resize(, 3).ClearContents Else .Offset(0, 1) = "...wait" Set objIE = CreateObject("InternetExplorer.Application") objIE.Navigate "https://www.imdb.com/name/" & .Text & "/" Do While objIE.Busy Or objIE.readystate <> 4 DoEvents Loop On Error Resume Next .Offset(0, 1) = objIE.Document.getElementsByClassName("itemprop")(0).innerText .Offset(0, 2) = objIE.Document.getElementsByTagName("time")(0).innerText Err.Clear On Error GoTo ErrorHandler If .Offset(0, 1) = "...wait" Then .Offset(0, 1) = "no data" End If End If End With ErrorHandler: Application.EnableEvents = True Set objIE = Nothing End Sub VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

On Error Resume Next .Offset(0, 1) = objIE.Document.getElementsByClassName("itemprop")(0).innerText If Mid(objIE.Document.getElementsByTagName("time")(0).ParentElement.innerText, 1, 4) = "Born" _ Then .Offset(0, 2) = objIE.Document.getElementsByTagName("time")(0).innerText Else .Offset(0, 2) = "" End If Err.Clear

Hallo
Ich hab hier einmal 10 (statt 789) eingesetzt. Geh in die erste Zelle und "ändere" sie. Wenn alles zu deiner Zufriedenheit fertig ist (wird etwas dauern) setze den Zähler auf 1 (damit kannst Du die Änderung drinnen lassen und bei Bedarf wieder aktivieren)
Ich hab den ganzen Code rein kopiert, wichtig ist aber nur die FOR-Schleife und die Änderung der WITH Anweisung ;-)


Private Sub Worksheet_Change(ByVal Target As Range)
Dim objIE As Object
Dim i As Integer
On Error GoTo ErrorHandler
Application.EnableEvents = False
For i = 1 To 10
With Target(i, 1)
If .Column = 2 And .Row > 1 Then
If .Value = "" Then
.Resize(, 3).ClearContents
Else
.Offset(0, 1) = "...wait"
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate "https://www.imdb.com/name/" & .Text & "/"
Do While objIE.Busy Or objIE.readystate  4
DoEvents
Loop
On Error Resume Next
.Offset(0, 1) = objIE.Document.getElementsByClassName("itemprop")(0). _
innerText
If Mid(objIE.Document.getElementsByTagName("time")(0).ParentElement. _
innerText, 1, 4) = "Born" Then
.Offset(0, 2) = objIE.Document.getElementsByTagName("time")(0). _
innerText
Else
.Offset(0, 2) = ""
End If
Err.Clear
On Error GoTo ErrorHandler
If .Offset(0, 1) = "...wait" Then .Offset(0, 1) = "no data"
End If
End If
End With
Next i
ErrorHandler:
Application.EnableEvents = True
Set objIE = Nothing
End Sub

Option Explicit Sub checkData() Dim objIE As Object, rng As Range, rngC As Range On Error Resume Next Application.ScreenUpdating = False Set rng = Range("B:B").SpecialCells(xlCellTypeConstants) If Not rng Is Nothing Then Set objIE = CreateObject("InternetExplorer.Application") For Each rngC In rng With rngC .Offset(0, 1).Resize(1, 2) = "" objIE.Navigate "https://www.imdb.com/name/" & .Text & "/" Do While objIE.Busy Or objIE.readystate <> 4 DoEvents Loop .Offset(0, 1) = objIE.Document.getElementsByClassName("itemprop")(0).innerText If Mid(objIE.Document.getElementsByTagName("time")(0).ParentElement.innerText, 1, 4) = "Born" Then .Offset(0, 2) = objIE.Document.getElementsByTagName("time")(0).innerText Else .Offset(0, 2) = "" End If If .Offset(0, 1) = "" Then .Offset(0, 1) = "no data" End With Next End If ErrorHandler: If Not objIE Is Nothing Then objIE.Quit Application.ScreenUpdating = True On Error GoTo 0 Set objIE = Nothing Set rng = Nothing Set rngC = Nothing End Sub VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Beliebteste Forumthreads (12 Monate)

per Makro zwei Daten von Inetseite auslesen

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

	A	B	C	D	E	F
1	Gruß Sepp
2
3

	A	B	C	D	E	F
1	Gruß Sepp
2
3

	A	B	C	D	E	F
1	Gruß Sepp
2
3

	A	B	C	D	E	F
1	Gruß Sepp
2
3

per Makro zwei Daten von Inetseite auslesen

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread