Hive links ud af en HTML-side

her er den kode jeg har fundet:

Public Sub StripURL(FilePath As String)
Dim tmpURL1, tmpURL2 As String

Open FilePath For Input As #1
Do Until EOF(1)
    Input #1, tmpURL1
    For X = 1 To Len(tmpURL1)
        tmpURL2 = Mid(tmpURL1, X, 7)
        If tmpURL2 = "http://" Then
            St1 = X
            tmpY = X
                For Y = 1 To Len(tmpURL1)
                    tmpURL2 = Mid(tmpURL1, tmpY, 1)
                        If tmpURL2 = Chr(34) Then
                            St2 = tmpY
                            lstURL.AddItem Mid(tmpURL1, St1, ((St2 - St1)))
                            Exit For
                        Else
                            tmpY = tmpY + 1
                        End If
                Next Y
        End If
    Next X
   
Loop

Close #1

Du kan da bare søge på <a href= i stedet for på http://

royal12..?

hmm..sorry...

Hvis du har problemer med at forstå koden, skal jeg gerne forsøge at hjælpe :o)
Tak for points

Og vil du forbedre koden en anelse, så brug Freefile i stedet for #1 :o)

Og så vidt jeg kan se, kan du undgå at loope over Y, men i stedet loope over tmpY, så du omskriver fra:


tmpY = X
For Y = 1 To Len(tmpURL1)
  tmpURL2 = Mid(tmpURL1, tmpY, 1)
  If tmpURL2 = Chr(34) Then
    St2 = tmpY
    lstURL.AddItem Mid(tmpURL1, St1, ((St2 - St1)))
    Exit For
  Else
    tmpY = tmpY + 1
  End If
Next Y


til


For tmpY = X To Len(tmpURL1-X)
  tmpURL2 = Mid(tmpURL1, tmpY, 1)
  If tmpURL2 = Chr(34) Then
    St2 = tmpY
    lstURL.AddItem Mid(tmpURL1, St1, ((St2 - St1)))
    Exit For
  End If
Next tmpY

Det er lidt simplere, og du sparer en variabel...

I øvrigt har du vel bemærket, at koden IKKE virker hvis et link deler sig over flere linier?

Lidt simplere endnu - du behøver hverken variablem Y eller St2:

For tmpY = X To Len(tmpURL1-X)
  tmpURL2 = Mid(tmpURL1, tmpY, 1)
  If tmpURL2 = Chr(34) Then
    lstURL.AddItem Mid(tmpURL1, St1, ((tmpY - St1)))
    Exit For
  End If
Next tmpY

Og så gider jeg ikke forsøge at optimere mere :o)