Find all words in string

[xT-Dart-Tx]

Hello,

lngPlace = 1
                Do Until lngPlace = 0
                    lngPlace = InStr(lngPlace, Packet, "<a href=", vbTextCompare)
                        HAXXX = lngPlace + 8
                        lngPlace = lngPlace + 1
                        lngLength = InStr(HAXXX + 1, Packet, ">", vbTextCompare)
                        lngLength = lngLength - HAXXX
                        strUrl = RemoveFlack(Mid$(Packet, HAXXX, lngLength)) 'grab url
                        Text1.Text = Text1.Text & vbNewLine & strUrl 'add both to list
                    X = X + 1
                Loop

That is pritty much my loop, but I'm having trouble making it realize when to stop looping, could anybody help me?

[anhn]

Option Explicit
 
Function FindAllRef(Packet As String) As String
   Const StartFlag = "<a href="
   Const EndFlag = ">"
   Dim n1 As Long
   Dim n2 As Long
   Dim sTemp As String
   Dim sRef As String
   
   n1 = 1
   Do
      n1 = InStr(n1, Packet, StartFlag, vbTextCompare)
      If n1 = 0 Then
         Exit Do
      End If
      n1 = n1 + Len(StartFlag)
      n2 = InStr(n1, Packet, EndFlag, vbTextCompare)
      If n2 > 0 Then
         sRef = Mid(Packet, n1, n2 - n1)
         If sTemp <> "" Then
            sTemp = sTemp & vbNewLine
         End If
         sTemp = sTemp & sRef
         n1 = n2 + Len(EndFlag)
      End If
   Loop
   
   FindAllRef = sTemp
      
End Function
 
'-- Use function:
'   Text1 = FindAllRef(aNewPacket)

[Lord Orwell]

looks to me like it should exit as soon as it doesn't find anything, as long as you fix your first line.

lngPlace = InStr(lngPlace+ 1, Packet, "<a href=", vbTextCompare)

in fact i am surprised it didn't return an error.

[xT-Dart-Tx]

Option Explicit
 
Function FindAllRef(Packet As String) As String
   Const StartFlag = "<a href="
   Const EndFlag = ">"
   Dim n1 As Long
   Dim n2 As Long
   Dim sTemp As String
   Dim sRef As String
   
   n1 = 1
   Do
      n1 = InStr(n1, Packet, StartFlag, vbTextCompare)
      If n1 = 0 Then
         Exit Do
      End If
      n1 = n1 + Len(StartFlag)
      n2 = InStr(n1, Packet, EndFlag, vbTextCompare)
      If n2 > 0 Then
         sRef = Mid(Packet, n1, n2 - n1)
         If sTemp <> "" Then
            sTemp = sTemp & vbNewLine
         End If
         sTemp = sTemp & sRef
         n1 = n2 + Len(EndFlag)
      End If
   Loop
   
   FindAllRef = sTemp
      
End Function
 
'-- Use function:
'   Text1 = FindAllRef(aNewPacket)

worked perfect, thanks

[Hack]

If you consider this resolved, you could help us out by pulling down the Thread Tools menu and clicking the Mark Thread Resolved menu item. That will let everyone know that you have your answer.

Thank you.