Hallo,
ich habe mir was in Excel-Vba geschrieben um in der Seite zu suchen, ich war mit der Googleanzeige nicht zufrieden.
Die Excel-Datei ist abrufbar unter:
http://www.badongo.com/file.php?file=Suche+in+http:-…
Der Code für die drei Schaltflächen ist nachstehend.
Gruß
Reinhard
Sub test2()
[Team: Quellcode gelöscht, verfügbar hier: http://vb-tec.de/openurl]
Dim s As String, n As Integer, ein As String, strURL, gef(), gef2(), z2 As Long
Dim pos As Long, such As String, z As Long, anz As Integer, zei As Long, adr As String
Rows("1:10000").Hidden = False
Columns("A:C").Clear
Application.ScreenUpdating = False
ein = InputBox("Geben Sie die Suchbegriffe ein")
If ein = "" Then Exit Sub
strURL = "http://www.google.de/search?num=100&hs=b3U&hl=de&client=firefox-a&rls=org.mozilla%3Ade%3Aofficial\_s&q="
ein = Replace(ein, " ", "+")
strURL = strURL & ein
strURL = strURL & "+site%3Ahttp%3A%2F%2Fmypage.bluewin.ch%2Freprobst%2FWordFAQ%2F&btnG=Suche&meta=lr%3Dlang\_de"
s = OpenURL(strURL)
such = "http://mypage.bluewin.ch/reprobst/WordFAQ/"
pos = 1
While InStr(pos, s, such) \> 0
z = InStr(pos, s, such) + 42 '41=len(Such)
pos = z + 1
If UCase(Mid(s, z, 1)) \> "A" And UCase(Mid(s, z, 1)) Chr(34)
gef(anz) = gef(anz) & Mid(s, z, 1)
z = z + 1
Wend
End If
Wend
If anz = 0 Then
MsgBox "Nichts gefunden bei der Suche nach: " & Chr(10) & "\>\>\>" & ein & "") + 4
While Mid(s, z, 1) "", "")
zei = zei + 1
While InStr(pos, s, "
- %2520%3E%25200%250D%250A%2520%2520%2520%2520%2520%2520%2520%2520z%2520=%2520InStr(pos,%2520s,%2520)%2520+%2520Len()Chr(34) adr = adr & Mid(s, z2, 1) …%250D%250A%2520%2520%2520%2520%2520%2520%2520%2520adr%2520=%2520)