VBA, um Text von Webseiten zu finden

Question

Ich habe Makro erstellt, das mir alle URLs auf allen Webseiten gibt. Wir müssen einfach die URL zur Verfügung zu stellen und es gibt uns die alle gegenwärtigen Links in dieser Webseite und fügen Sie ihn in eine Spalte

Private Sub CommandButton4_Click() 

'We refer to an active copy of Internet Explorer 
Dim ie As InternetExplorer 
'code to refer to the HTML document returned 
Dim html As HTMLDocument 
Dim ElementCol As Object 
Dim Link As Object 
Dim erow As Long 
Application.ScreenUpdating = False 
'open Internet Explorer and go to website 
Set ie = New InternetExplorer 
ie.Visible = True 
ie.navigate Cells(1, 1) 

'Wait until IE is done loading page 
Do While ie.READYSTATE <> READYSTATE_COMPLETE 

Application.StatusBar = "Trying to go to website…" 
DoEvents 
Loop 

Set html = ie.document 
'Display text of HTML document returned in a cell 
'Range("A1") = html.DocumentElement.innerHTML 
Set ElementCol = html.getElementsByTagName("a") 

For Each Link In ElementCol 
erow = Worksheets("Sheet4").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
Cells(erow, 1).Value = Link 
Cells(erow, 1).Columns.AutoFit 
Next 

'close down IE, reset status bar & turn on screenupdating 

'Set ie = Nothing 
Application.StatusBar = "" 
Application.ScreenUpdating = True 
ie.Quit 
ActiveSheet.Range("$A$1:$A$2752").removeDuplicates Columns:=1, Header:=xlNo 

End Sub 

Jetzt kann jeder helfen kann mir Makro zu erstellen vorliegenden bestimmten Text aus all diesen URLs zu finden in Spalte und wenn dieser Text vorhanden ist, dann sollte in der nächsten Spalte der Text "Text gefunden" gedruckt werden.

Beispiel wenn wir den Text "Neu" suchen, dann sollte der Text "Text gefunden" in der nächsten Spalte der URL gedruckt werden.

Vielen Dank.

Answer 1

Der Schlüssel wäre die Funktion Instr, wenn es die Zeichenfolge „New“ findet, die Position zurückkehrt, wo es beginnt, andernfalls gibt es 0.

i=1 
do until trim(Cells(i,1).Value) = vbNullString 
    if instr(Cells(i,1).Value,"New") then 
     Cells(i,2).value="Text found" 
    end if 
    i=i+1 
loop 

Answer 2

ähnlich wie oben.

Dim a As Variant 

a = 2 

While Cells(a, 1) <> "" And Cells(a + 1, 1) <> "" 

    If InStr(Cells(a, 1), "new") = 0 Then 

    Else 
     Cells(a, 2) = "Text Found" 

    End If 

    a = a + 1 

Wend