PDA

View Full Version : Solved: URL -No Highlight Search Results.



omnibuster
04-13-2009, 08:04 AM
When use ForumSearch then URL shows:
URL+&higlight=Searchstring+string+string..
How to delete this end of URL with VBA in Excel Sheet?


Private Sub CommandButton1_Click()
Dim SWs As SHDocVw.ShellWindows
Dim i As Integer
Dim Adres As String
Set SWs = New SHDocVw.ShellWindows
For i = SWs.Count - 1 To 0 Step -1
Adres = CStr(SWs(i).LocationURL)
'http://www.vbaexpress.com/forum/showthread.php?t=26180&highlight=URL+Delete+INDEX

If Adres Like "*&highlight=" Then
All after & ("*&highlight=")..Delete


If Adres Like "http*" Then
Range("b1").Hyperlinks.Add _
Anchor:=Range("b1"), _
Address:=Adres, _
TextToDisplay:=Adres
Exit For
End If
Next i
Range("b1").Select
Set SWs = Nothing
End Sub

Kenneth Hobs
04-13-2009, 08:17 AM
Not sure what you need. I generally delete all the hyperlinks and then refresh the ones that I want active. e.g. http://vbaexpress.com/forum/showthread.php?p=181830

omnibuster
04-13-2009, 08:44 AM
Thank Kenneth.
No. I dont need delete hyperlinks.
I want delete all after &.. included & too.
Red colored.

'http://www.vbaexpress.com/forum/showthread.php?t=26180&highlight=URL+Delete+INDEX

Zack Barresse
04-13-2009, 09:13 AM
Do you want to add the correct URL as a hyperlink then? Or do you want to navigate that window to the URL you want?

omnibuster
04-13-2009, 09:44 AM
I using DRJ file.(Litle modified)
http://www.vbaexpress.com/kb/getarticle.php?kb_id=159

Yes. I need correct hyperlink .
If i find interesting Link i download in my WorkBook for future....

Zack Barresse
04-13-2009, 11:05 AM
Oh, gotcha. This will work. Tested in IE7, loops through all tabs and gets dynamic list...
Private Sub CommandButton1_Click()
'Reference needed for Microsoft Internet Controls
Dim SWs As SHDocVw.ShellWindows
Dim i As Long, iRow As Long, Adres As String
Set SWs = New SHDocVw.ShellWindows
iRow = 1 'starting row
For i = SWs.Count - 1 To 0 Step -1
Adres = CStr(SWs(i).LocationURL)
If Adres Like "*&highlight=*" Then
If Adres Like "http*" Then
Adres = Left(Adres, InStr(1, Adres, "&highlight=") - 1)
Cells(iRow, "B").Hyperlinks.Add Anchor:=Cells(iRow, "B"), Address:=Adres, TextToDisplay:=Adres
iRow = iRow + 1
End If
End If
Next i
Range("b1").Select
Set SWs = Nothing
End Sub
If you want the individual thread, leave this line in...
Adres = Left(Adres, InStr(1, Adres, "&highlight=") - 1)
If you want the entire URL as it stands (with the highlight portion), take it out.

HTH

omnibuster
04-13-2009, 12:55 PM
Big Thank for you Zack.
I litle modified your code.
Same time I have many opened IE Tab-s, but only Last Tab for Excel search,
(other Tabs for news, weather: -these not for download.)

Private Sub CommandButton1_Click()
'Reference needed for Microsoft Internet Controls
Dim SWs As SHDocVw.ShellWindows
Dim i As Long, Adres As String
Set SWs = New SHDocVw.ShellWindows

For i = SWs.Count - 1 To 0 Step -1
Adres = CStr(SWs(i).LocationURL)
If Adres Like "*&highlight=*" Then
Adres = Left(Adres, InStr(1, Adres, "&highlight=") - 1)
Range("b1").Hyperlinks.Add Anchor:=Range("b1"), Address:=Adres, TextToDisplay:=Adres
Exit For
Else
If Adres Like "http*" Then
Range("b1").Hyperlinks.Add Anchor:=Range("b1"), Address:=Adres, TextToDisplay:=Adres
Exit For
End If
End If
Next i
Range("b1").Select
Set SWs = Nothing
End Sub