webside prüfen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: webside prüfen

25.11.2021 08:31:24

Ein

AW: webside prüfen

01.12.2021 15:27:34

Michael

Moin auch,
dass hier noch keiner was zu geschrieben hat, könnte daran liegen, dass es ein kaum excelspezifisches Problem ist.
Aber mal ein Versuch...
Deine Idee, erneut zu prüfen ist sicher nicht schlecht, nur mit der Meldung "Status 200 und OK" kannst Du doch im Grunde zunächst überhaupt nichts mehr anfangen. Das erste Test müsste jetzt doch sein, ob Du die Meldung "Leider wurde diese Website nicht für Sie freigegeben." bekommst, oder nicht. Wenn die nicht kommt, ist der Status 200. Und sonst hört sich das ein bisschen an, wie Zugriffsberechtigungsprobleme ("...freigegeben."). Ist das wirklich gleichzusetzen mit Status 404?
Wie die Prüfung auf "Leider...nicht...freigegeben." aussehen muss, weiß ich leider nicht. Vielleicht kommt da jemand drauf, den den Code sehen würde. Ich eher nicht. Ist die Adresse dieser Seite immer dieselbe? Kommst Du mit dem Code da dran?
VG
Michael

Moin Michael
war leider unpässlich, deswegen verspätet.
Du hast mein Problem weitestgehend erkannt. Die Kollegen unserer IT haben unseren SharePoint dahin gehend modifiziert, das die Meldung "Leider wurde diese Website nicht für Sie freigegeben." dann auftaucht, wenn ich eine Web Adresse aufrufe, welche im SharePoint so nicht mehr existiert, wir sprechen hier nicht von einem Zugriffsberechtigungsprobleme, und hier liegt weiterhin das Problem, wie kann ich jetzt, meine in Spalte B im Blatt "Link" abgelegten Web Adressen, überprüfen, da ja der Status 404 nicht mehr erzeugt wird, stattdessen sich eine Web Seite öffnet mit dieser tollen Meldung "Leider wurde diese Website nicht für Sie freigegeben.", bzw. gibt es eine Möglichkeit über vba eine zusätzliche Abfrage im Bezug auf diesen Text, zu programmieren?
Hier diesmal noch das Programm, welches vor dieser IT Modifizierung noch wunderbar funktioniert hat....


Sub CheckURL2_Link()
Sheets("Link").Activate
Dim rngBer As Range, rngC As Range, oHttpReq As Object
Dim sUrl As String, lngS As Long, strErg As String
Set oHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
Columns("C:E").ClearContents
Set rngBer = Cells(2, 2).Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1)
rngBer.Interior.Pattern = xlNone
On Error Resume Next
With oHttpReq
For Each rngC In rngBer
sUrl = rngC.Text
If Len(sUrl) > 4 Then ' mind. 5 Zeichen
' falls nötig, vorn "h ttp://" ergänzen
If LCase$(Left$(sUrl, 7)) = "h ttp://" Then sUrl = "h ttp://" & sUrl
lngS = 0
.Open "GET", sUrl
.Send
lngS = .Status
Select Case lngS
Case 200:   strErg = .StatusText
Case 404:   strErg = .StatusText
rngC.Interior.Color = 255
Case Else:  strErg = "Fehler"
rngC.Interior.Color = 255
End Select
rngC.Offset(0, 1) = lngS                        ' zum Testen
rngC.Offset(0, 2) = strErg                      ' zum Testen
rngC.Offset(0, 3) = sUrl                        ' zum Testen
End If
Next rngC
End With
On Error GoTo 0
Set oHttpReq = Nothing
End 

Sub

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread