Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

perVBA prüfen, ob Internetadresse vorhanden

perVBA prüfen, ob Internetadresse vorhanden
Rüdiger
Liebe Fachleute für InternetExplorer aus Excel-VBA heraus!
ich habe Excelsheet mit Adressen u.a. auch URLs (und Mailadr.)
ich möchte prüfen, ob die in meiner Liste (eine Spalte) erfassten URLs seit der letzten Mailingsaktion vor einem Jahr noch erreichbar sind:
(In einem weiteren Schritt möchte ich dann die im Impressum auf den Seiten gespeicherte Mailadresse auslesen und im Excelsheet abspeichern. Das ist noch Zukunftsmusik...)
Wenn die URL erreichbar ist, soll in meinem Excelsheet ein entsprechender Eintrag in einer Spalte gemacht werden, wenn die Adresse nicht mehr erreichbar oder vorhanden ist, soll in der Spalte ein "f" eingetragen werden.
Der Teil in meinem Prog schaut im Moment so aus

Sub IntKontrolle()
do while (Schleife über alle i Zeilen)....
strInternetAdr = oEx1.Cells(i, 7).Value   ' mein Excelsheet
bInternetAdr = InternetSeiteAuf()
wend
End Sub
Function InternetSeiteAuf() as Boolean
Dim Web As Object
Set Web = CreateObject("InternetExplorer.Application")
'  Wenn Internetseite nicht existiert/erreichbar muss Fehlerroutine aufgerufen werden
'  dann muss InternetSeiteAuf false zurückgeben
Web.Navigate (strInternetAdr)
Web.Left = 10
Web.Top = 10
Web.Height = 500
Web.Width = 750
Web.Visible = True
Do while Web.ReadState  4
loop
'wie stelle ich fest, dass URL falsch oder nicht erreichbar?
'dann weiter nach IntAdrFalsch:
InternetSeiteAuf = True
GoTo IntAdrOk:
IntAdrFalsch:
InternetSeiteAuf = False
IntAdrOk:
Web.Quit
End Function

Allerdings hat mir

Do while Web.ReadState  4
immer nur ein leeres Explorer-Fenster geöffnet, hat wohl nie

ReadyState 4
gefunden.
Abhilfe war dann:

Do: Loop Until Web.Busy = False

(wenn Seite erscheint, kommt MsgBox Frage ob weitere Seite dann schließen Seite über Web.Quit)
1. Frage:
Beim ersten Mal kommt Seite hoch
https://www.herber.de/bbs/user/65189.doc
Bei allen anderen Seiten geht's
Wenn ich die erste URL normal eingebe, wird sie einwandfrei geöffnet...
2. Frage:
Wie aber kann ich verfahren, wenn ich vom IE (auf einer Seite) die Nachricht bekomme, dass es die Seite nicht gibt? Getestet, passiert.
Dann müsste ich ja den Inhalt der Seite abfragen, oder kann ich eine Systemvar abfragen?
Oder kann es sein, dass immer weiter versucht wird die Seite zu finden und sich der IE aufhängt?!
Würde mich freuen, wenn mir einer von euch weiterhelfen könnte.
Vielen Dank und Grüße
Rüdiger

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: perVBA prüfen, ob Internetadresse vorhanden
19.10.2009 13:06:55
Oberschlumpf
Hi Rüdiger
Ohne, dass ich mir jetzt deinen Code genauer angeschaut habe (ich also nich genau weiß, wo du prüfen willst, ob Website vorhanden oder nicht), hier trotzdem für dich der Tipp, wie man Websites auf Erreichbarkeit prüfen kann.
schreib alles in ein allgemeines Modul:

Private Const FIFC = &H1
Private Declare Function InternetCheckConnection Lib "wininet.dll" Alias " _
InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Sub sbURLtest()
Dim lstrURL As String
lstrURL = "http://gibs-mir-gratis.de/Tipsaz.htm" 'hier musst du anpassen - z Bsp google.de
If InternetCheckConnection(lstrURL, FIFC, 0&) = 0 Then
MsgBox "Seite nicht erreichbar"
Else
MsgBox "Seite erreichbar"
End If
End Sub

Hilfts?
Ciao
Thorsten
Anzeige
AW: perVBA prüfen, ob Internetadresse vorhanden
19.10.2009 13:51:34
Rüdiger
Hi Oberschlumpf,
vielen Dank für deinen Hinweis! Ich probier es gleich mal aus!
Grüße
Rüdiger
AW: perVBA prüfen, ob Internetadresse vorhanden
20.10.2009 09:27:08
Rüdiger
Hi Oberschlumpf,
ich habe deinen Hinweis eingebaut, aber ich bekomme für jede Seite, egal ob sie tatsächlich erreichbar ist oder nicht immer "Seite nicht erreichbar"
Der Code sieht so aus:
direkt auf Modulebene habe ich das Declare eingebaut.
für jeden Datensatz rufe ich das sbURLTest auf und übergebe die zu prüfende URL
Call sbURLtest(ByVal strInternetAdr)

Im sbURLTest steht:

Sub sbURLtest(ByVal lstrURL As String)
Dim Web As Object
If InternetCheckConnection(lstrURL, FIFC, 0&) = 0 Then
bInternetAdr = False
MsgBox "Seite nicht erreichbar"
Else
bInternetAdr = True
MsgBox "Seite erreichbar"
End If
End Sub
(bInternetAdr ist auf Modulebene definiert)
Zuerst hatte ich das als Funktion, die direkt das bInternetAdr (Adresse gibt es/gibt es nicht) zurückgibt => genau der gleiche Fehler, dachte also das müsste ein Sub sein, aber auch das läuft nicht
InternetCheckConnection(lstrURL, FIFC, 0&) ergibt in jedem Fall "0"
Auch ob ich das http:// selbst voranstelle oder nicht, ändert nichts.
Habe jetzt weiter gegoogelt und unter "office-lösung.de" etwas gefunden:
lngStatus = GetLinkStatus(strUrl)
If lngStatus = 200 Then
MsgBox "OK"
Else
MsgBox "Fehler " & lngStatus
End If 
Das versuche ich jetzt.
auf jeden Fall vielen Dank für deinen Tipp
Grüße
Rüdiger
Anzeige
AW: perVBA prüfen, ob Internetadresse vorhanden
20.10.2009 09:50:37
Oberschlumpf
HI Rüdiger
Hmm...komisch...weil...
Meine vorgestellte Idee verwende ich (natürlich für mich angepasst) für das Prüfen aller meiner Einträge in den Favoriten.
Und da es sich da ja nur um Internetadressen handelt, und ich sehr viele Favoriten habe, teste ich halt in größeren Abständen, ob noch alle erreichbar sind.
Bei mir funktioniert es einwandfrei.
Schade, dass das bei dir nicht der Fall ist. Aber eine weitere Idee habe ich leider nicht.
Ciao
Thorsten
AW: perVBA prüfen, ob Internetadresse vorhanden
20.10.2009 10:57:17
Rüdiger
Hi Oberschlumpf,
das, was ich im Office-Forum gefunden habe, scheint zu funktionieren:
die eine URL, die bewusst verändert habe, wird wirklich als falsch erkannt und andere richtige werden als vorhanden erkannt, habe natürlich noch nicht alle getestet, aber schaut recht gut aus.
Mit dem GetLinkStatus scheint nur geprüft zu werden, ob der Server antwortet.
Public Function GetLinkStatus(ByVal strUrl As String) As Long
Dim oHttp As Object
If Not VBA.Left(strUrl, 7) = "http://" Then strUrl = "http://" & strUrl
Set oHttp = CreateObject("Msxml2.XMLHTTP")
On Error Resume Next
oHttp.Open "GET", strUrl, False
oHttp.Send
GetLinkStatus = oHttp.Status
Set oHttp = Nothing
On Error GoTo 0
End Function

Zu diesem kryptischen Msxml2.XMLHTTP habe ich gerade auch schon was "ergoogelt"
Grüße
Rüdiger
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen