Gruppe
Extern
Problem
Es soll geprüft werden, ob die in Spalte A gelisteten Domaines noch verfügbar sind.
StandardModule: Modul1
Sub AdressePruefen()
Dim iRow As Integer
Dim sTxt As String
For iRow = 1 To 6
sTxt = MessageLaden("http://www.ripe.net/perl/whois?query=" _
& Cells(iRow, 1) & "&.submit=Anfrage+senden")
If InStr(sTxt, "descr: ") Then
sTxt = Right(sTxt, Len(sTxt) - InStr(sTxt, "descr: ") - 12)
sTxt = Left(sTxt, InStr(sTxt, "descr: ") - 1)
sTxt = WorksheetFunction.Clean(sTxt)
Else
sTxt = "Noch frei"
End If
If sTxt = "" Then sTxt = "Noch frei"
Cells(iRow, 2) = sTxt
Next iRow
MsgBox "Bin fertig!"
End Sub
Function MessageLaden(URL As String) As String
Dim IEApp As Object
Dim IEDocument As Object
Dim i As Long
Set IEApp = CreateObject("InternetExplorer.Application")
IEApp.Visible = False
IEApp.Navigate URL
Do: Loop Until IEApp.Busy = False
Do: Loop Until IEApp.Busy = False
Set IEDocument = IEApp.Document
MessageLaden = IEDocument.Body.innerText
IEApp.Quit
Set IEDocument = Nothing
Set IEApp = Nothing
End Function