Problem är till för att lösas ;)

En sak till, vill du att saker som "target="_blank" etc också ska komma med?
I så fall får jag skriva om koden lite till =)

Här har jag i alla fall ordnat föregående kod lite, nu klarar den även av om det står något annat element före href...

<code>
Private Function ActivateLinks(Text)
Dim RegExp
Set RegExp = New RegExp

RegExp.Global = True
RegExp.IgnoreCase = True

'Fixa till de färdiga länkarna
RegExp.Pattern = "<a\s([\w\W]*?)href=""([\w\W]+?)""([\w\W]*?)>([\w\W]*?)</a>"
Text = RegExp.Replace(Text, "$4")

'Radera redan länkad e-post
RegExp.Pattern = "<a\shref=""mailto:([\w\W]+?)""[\w\W]*?>([\w\W]*?)</a>"
Text = RegExp.Replace(Text, " $1 |$2|")

'Radera redan länkade externa länkar
RegExp.Pattern = "<a\shref=""(https?://[\w\W]+?)""[\w\W]*?>([\w\W]*?)</a>"
Text = RegExp.Replace(Text, " $1 |$2|")

'Fixa till www. länkar
RegExp.Pattern = "(^|\s|>)(www\.[^\s<]+)"
Text = RegExp.Replace(Text, "$1http://$2")

'Ersätt länkar
RegExp.Pattern = "(^|\s|>)(https?://[^\s<]+)"
Text = RegExp.Replace(Text, "$1$2")

'Ersätt e-post adresser
RegExp.Pattern = "(^|\s|>)([^\s""\|>]+@[^\s<\|]+)"
Text = RegExp.Replace(Text, "$1$2")

'Fixa till eventuella namn på länkar
RegExp.Pattern = "\2\s\|(.+?)\|"
Text = RegExp.Replace(Text, "$3")

Set RegExp = Nothing
ActivateLinks = Text
End Function
</code>

Mvh,
Thomas

Gällande target vore det fint om externa länkar kan styras till att bli _blank medan interna länkar som default använder sidstandarden och inte har nån angiven target. Om en länk däremot manuellt redigerats till att bryta det mönstret och har en annan target vore det trevligt om den ändå får förbli oförändrad.

En liten skönhetsdetalj också :)
Om en länk heter www.en-url.com så vore det snyggare om inte http:// skrivs ut i själva den klickbara texten.

Slutligen, släng gärna in kommentarer om att det är du som gjort funktionen i källkoden. Det känns bara rätt om credit går till dig.

Jag ska ordna dina önskemål =)
Ska slänga in någon kommentar att det är jag som gjort funktionen.
Ska också fixa den där skönhetsdetaljen ;)

Postar hit sen när den är klar...

Mvh,
Thomas

Hej!

Nu tror jag att jag är klar med funktionen...
Försökte även fixa eventuella problem som skulle kunna uppstå beroende på vad de färdiga länkarna har för namn...
Fixade skönhetssaken och lade till kommentarer samt att man kan ställa in egenskaper för länkarna...
Om ingen target existerar och det är en extern länk ska den öppnas i ett nytt fönster...

<code>
Private Function ActivateLinks(Text)
'Funktionen skapad av Thomas Vanhaniemi (thomas@eurocitynet.nu)
'Skapad 18/6 2004
'All användning tillåten

Dim RegExp
Dim Spacer
Dim SpacerPattern
Set RegExp = New RegExp

Spacer = "-%|%-"
SpacerPattern = TextToPattern(Spacer)

RegExp.Global = True
RegExp.IgnoreCase = True

'Möblera om de färdiga länkarna
RegExp.Pattern = "<a([\w\W]*?)\s+href=""([\w\W]+?)""([\w\W]*?)\s*>([\w\W]*?)</a>"
Text = RegExp.Replace(Text, "$4")

'Radera redan länkad e-post
RegExp.Pattern = "<a\shref=""mailto:([\w\W]+?)""([\w\W]*?)\s*>([\w\W]*?)</a>"
Text = RegExp.Replace(Text, " $1 " & Spacer & "$2" & Spacer & "$3" & Spacer)

'Radera redan länkade externa länkar
RegExp.Pattern = "<a\shref=""(https?://[\w\W]+?)""([\w\W]*?)>([\w\W]*?)</a>"
Text = RegExp.Replace(Text, " $1 " & Spacer & "$2" & Spacer & "$3" & Spacer)

'Ersätt länkar
RegExp.Pattern = "(^|\s|>)(https?://[^\s<]+)"
Text = RegExp.Replace(Text, "$1$2")

'Ersätt www länkar
RegExp.Pattern = "(^|\s|>)(www\.[^\s<]+)"
Text = RegExp.Replace(Text, "$1$2")

'Ersätt e-post adresser
RegExp.Pattern = "(^|\s|>)([^\s""\|>]+@[^\s<\|]+)"
Text = RegExp.Replace(Text, "$1$2")

'Fixa till eventuella namn på länkar med target angett
RegExp.Pattern = "\2\s" & SpacerPattern & "(.{0,50}target="".*?"".{0,50})" & SpacerPattern & "(.{0,50})" & SpacerPattern
Text = RegExp.Replace(Text, "$4")

'Fixa till eventuella namn på länkar utan target angett
RegExp.Pattern = "\2\s" & SpacerPattern & "(.{0,50})" & SpacerPattern & "(.{0,50})" & SpacerPattern
Text = RegExp.Replace(Text, "$4")

Set RegExp = Nothing
ActivateLinks = Text
End Function

Function TextToPattern(Text)
'Funktionen skapad av Thomas Vanhaniemi (thomas@eurocitynet.nu)
'Skapad 18/6 2004
'All användning tillåten

Dim RegExp
Dim Res
Set RegExp = New RegExp

RegExp.Global = True
RegExp.IgnoreCase = True

RegExp.Pattern = "([\.\+\?\*\[\{\^\$\|\(\)\\])"
Res = RegExp.Replace(Text, "\$1")

Set RegExp = Nothing
TextToPattern = Res
End Function
</code>

Mvh,
Thomas

Enormt tack för hjälpen!

Kan jag maila dig om nån situation skulle uppstå som funktionen ej klarar? :)

Varsågod, det var en intressant utmaning bara =)
Det är bara att maila mig om något är fel =)

God fortsättning!

Mvh,
Thomas

Stötte på en länk som ger fel...

Denna kod:
ÖLFA - Östergötlands Arkivförbund

Ger denna utdata på skärmen:
http://www.olfa.nu -%|%--%|%-ÖLFA - Östergötlands Arkivförbund-%|%-

Edit:
Såg själv felet nu... ett mellanslag smög sig in efter .nu :)

Kan du kanske även filtrera bort felaktiga mellanslag som hamnat inom href? :)

Testa följande...
Fixade problemet med mellanslag...

<code>
Private Function ActivateLinks(Text)
'Funktionen skapad av Thomas Vanhaniemi (thomas@eurocitynet.nu)
'Skapad 18/6 2004
'All användning tillåten

Dim RegExp
Dim Spacer
Dim SpacerPattern
Set RegExp = New RegExp

Spacer = "-%|%-"
SpacerPattern = TextToPattern(Spacer)

RegExp.Global = True
RegExp.IgnoreCase = True

'Möblera om de färdiga länkarna
RegExp.Pattern = "<a([\w\W]*?)\s+href=""\s*([^\s""]+)\s*""([\w\W]*?)\s*>([\w\W]*?)</a>"
Text = RegExp.Replace(Text, "$4")

'Radera redan länkad e-post
RegExp.Pattern = "<a\shref=""mailto:([\w\W]+?)""([\w\W]*?)\s*>([\w\W]*?)</a>"
Text = RegExp.Replace(Text, " $1 " & Spacer & "$2" & Spacer & "$3" & Spacer)

'Radera redan länkade externa länkar
RegExp.Pattern = "<a\shref=""(https?://[\w\W]+?)""([\w\W]*?)>([\w\W]*?)</a>"
Text = RegExp.Replace(Text, " $1 " & Spacer & "$2" & Spacer & "$3" & Spacer)

'Ersätt länkar
RegExp.Pattern = "(^|\s|>)(https?://[^\s<]+)"
Text = RegExp.Replace(Text, "$1$2")

'Ersätt www länkar
RegExp.Pattern = "(^|\s|>)(www\.[^\s<]+)"
Text = RegExp.Replace(Text, "$1$2")

'Ersätt e-post adresser
RegExp.Pattern = "(^|\s|>)([^\s""\|>]+@[^\s<\|]+)"
Text = RegExp.Replace(Text, "$1$2")

'Fixa till eventuella namn på länkar med target angett
RegExp.Pattern = "\2\s" & SpacerPattern & "(.{0,50}target="".*?"".{0,50})" & SpacerPattern & "(.{0,50})" & SpacerPattern
Text = RegExp.Replace(Text, "$4")

'Fixa till eventuella namn på länkar utan target angett
RegExp.Pattern = "\2\s" & SpacerPattern & "(.{0,50})" & SpacerPattern & "(.{0,50})" & SpacerPattern
Text = RegExp.Replace(Text, "$4")

Set RegExp = Nothing
ActivateLinks = Text
End Function

Function TextToPattern(Text)
'Funktionen skapad av Thomas Vanhaniemi (thomas@eurocitynet.nu)
'Skapad 18/6 2004
'All användning tillåten

Dim RegExp
Dim Res
Set RegExp = New RegExp

RegExp.Global = True
RegExp.IgnoreCase = True

RegExp.Pattern = "([\.\+\?\*\[\{\^\$\|\(\)\\])"
Res = RegExp.Replace(Text, "\$1")

Set RegExp = Nothing
TextToPattern = Res
End Function
</code>

Mvh,
Thomas

Finemang!

Just idag har jag inget behov av det, men om du bara för skojs skull känner för det att utöka funktionen, lägg gärna till att den även klarar ftp-adresser (default _blank även på dem).

:)

No problemos, här kommer koden för att stödja ftp adresser också!

<code>
Private Function ActivateLinks(Text)
'Funktionen skapad av Thomas Vanhaniemi (thomas@eurocitynet.nu)
'Skapad 18/6 2004
'All användning tillåten

Dim RegExp
Dim Spacer
Dim SpacerPattern
Set RegExp = New RegExp

Spacer = "-%|%-"
SpacerPattern = TextToPattern(Spacer)

RegExp.Global = True
RegExp.IgnoreCase = True

'Möblera om de färdiga länkarna
RegExp.Pattern = "<a([\w\W]*?)\s+href=""\s*([^\s""]+)\s*""([\w\W]*?)\s*>([\w\W]*?)</a>"
Text = RegExp.Replace(Text, "$4")

'Radera redan länkad e-post
RegExp.Pattern = "<a\shref=""mailto:([\w\W]+?)""([\w\W]*?)\s*>([\w\W]*?)</a>"
Text = RegExp.Replace(Text, " $1 " & Spacer & "$2" & Spacer & "$3" & Spacer)

'Radera redan länkade externa länkar
RegExp.Pattern = "<a\shref=""((?:https?://|ftps?://)[\w\W]+?)""([\w\W]*?)>([\w\W]*?)</a>"
Text = RegExp.Replace(Text, " $1 " & Spacer & "$2" & Spacer & "$3" & Spacer)

'Ersätt länkar
RegExp.Pattern = "(^|\s|>)((?:https?://|ftps?://)[^\s<]+)"
Text = RegExp.Replace(Text, "$1$2")

'Ersätt www länkar
RegExp.Pattern = "(^|\s|>)(www\.[^\s<]+)"
Text = RegExp.Replace(Text, "$1$2")

'Ersätt e-post adresser
RegExp.Pattern = "(^|\s|>)([^\s""\|>]+@[^\s<\|]+)"
Text = RegExp.Replace(Text, "$1$2")

'Fixa till eventuella namn på länkar med target angett
RegExp.Pattern = "\2\s" & SpacerPattern & "(.{0,50}target="".*?"".{0,50})" & SpacerPattern & "(.{0,50})" & SpacerPattern
Text = RegExp.Replace(Text, "$4")

'Fixa till eventuella namn på länkar utan target angett
RegExp.Pattern = "\2\s" & SpacerPattern & "(.{0,50})" & SpacerPattern & "(.{0,50})" & SpacerPattern
Text = RegExp.Replace(Text, "$4")

Set RegExp = Nothing
ActivateLinks = Text
End Function

Function TextToPattern(Text)
'Funktionen skapad av Thomas Vanhaniemi (thomas@eurocitynet.nu)
'Skapad 18/6 2004
'All användning tillåten

Dim RegExp
Dim Res
Set RegExp = New RegExp

RegExp.Global = True
RegExp.IgnoreCase = True

RegExp.Pattern = "([\.\+\?\*\[\{\^\$\|\(\)\\])"
Res = RegExp.Replace(Text, "\$1")

Set RegExp = Nothing
TextToPattern = Res
End Function
</code>

Mvh,
Thomas

En småsak kanske, men den tar t.ex. ftp://ftp.en-url.com men inte när det enbart står ftp.en-url.com
:)

En sak till.
Har en länk skrivits med blanksteg får den problem:
www.en-url.com/en mapp/index.html

Är ftp.en-url.com en giltlig "adress"?
Inga problem att lägga in det, men korrekt ska ju vara korrekt ;)

Mvh,
Thomas

Bra fråga, men att utelämna ftp:// bör väl vara lika "korrekt" som att utelämna http:// på en webbsida... eller? :)

Testade i Internet Explorer vad den sa och enligt den är det korrekt att skriva ftp.en-url.com så jag får väl lägga in stöd för det i funktionen ;)
Har för övrigt nyss gjort en funktion i VBScript som kontrollerar om en angiven e-post adress är i korrekt format =)

Du hittar den här om det är intressant: [Validera e-post adress]

Hoppas den fungerar bra, har ju inte haft möjlighet att testa den desstomer ;)

Mvh,
Thomas

Hej igen!

Nu har jag modifierat koden så den klarar av mellanslag i länkar som är länkade samt ftp. och ftps. länkar...

<code>
Private Function ActivateLinks(Text)
'Funktionen skapad av Thomas Vanhaniemi (thomas@eurocitynet.nu)
'Skapad 20/6 2004
'All användning tillåten

Dim RegExp
Dim Spacer
Dim SpacerPattern
Set RegExp = New RegExp

Spacer = "-%|%-"
SpacerPattern = TextToPattern(Spacer)

RegExp.Global = True
RegExp.IgnoreCase = True

'Möblera om de färdiga länkarna
RegExp.Pattern = "<a([\w\W]*?)\s+href=\s*""\s*([^""]+?)\s*""([\w\W]*?)\s*>([\w\W]*?)</a>"
Text = RegExp.Replace(Text, "$4")

'Ersätt alla mellanslag med "%20" i alla existerande länkar
Dim Match, Matches
RegExp.Pattern = "<a\shref=""[^""\?]+"
Set Matches = RegExp.Execute(Text)
For Each Match In Matches
Text = Replace(Text, Match.Value, "<a " & Replace(Match.Value, " ", "%20", 4), 1, 1)
Next

'Radera redan länkad e-post
RegExp.Pattern = "<a\s+href=""mailto:([^""]+)""([\w\W]*?)\s*>([\w\W]*?)</a>"
Text = RegExp.Replace(Text, " $1 " & Spacer & "$2" & Spacer & "$3" & Spacer)

'Radera redan länkade externa länkar
RegExp.Pattern = "<a\s+href=""((?:https?://|ftps?://)[^""]+)""([^>]*)>([\w\W]*?)</a>"
Text = RegExp.Replace(Text, " $1 " & Spacer & "$2" & Spacer & "$3" & Spacer)

'Ersätt länkar
RegExp.Pattern = "(^|\s|>)(?:(https?)://|(ftp)s?://)([^\s<]+)"
Text = RegExp.Replace(Text, "$1$2$3://$4")

'Ersätt www länkar
RegExp.Pattern = "(^|\s|>)(www\.[^\s<]+)"
Text = RegExp.Replace(Text, "$1$2")

'Ersätt ftp länkar
RegExp.Pattern = "(^|\s|>)(ftps?\.[^\s<]+)"
Text = RegExp.Replace(Text, "$1$2")

'Ersätt e-post adresser
RegExp.Pattern = "(^|\s|>)([^\s""\|>]+@[^\s<\|]+)"
Text = RegExp.Replace(Text, "$1$2")

'Fixa till eventuella namn på länkar med target angett
RegExp.Pattern = "\2\s" & SpacerPattern & "(.{0,50}target="".*?"".{0,50})" & SpacerPattern & "(.{0,50})" & SpacerPattern
Text = RegExp.Replace(Text, "$4")

'Fixa till eventuella namn på länkar utan target angett
RegExp.Pattern = "\2\s" & SpacerPattern & "(.{0,50})" & SpacerPattern & "(.{0,50})" & SpacerPattern
Text = RegExp.Replace(Text, "$4")

Set RegExp = Nothing
ActivateLinks = Text
End Function

Function TextToPattern(Text)
'Funktionen skapad av Thomas Vanhaniemi (thomas@eurocitynet.nu)
'Skapad 20/6 2004
'All användning tillåten

Dim RegExp
Dim Res
Set RegExp = New RegExp

RegExp.Global = True
RegExp.IgnoreCase = True

RegExp.Pattern = "([\.\+\?\*\[\]\{\^\$\|\(\)\\])"
Res = RegExp.Replace(Text, "\$1")

RegExp.Pattern = "\n"
Res = RegExp.Replace(Res, "\n")

RegExp.Pattern = "\t"
Res = RegExp.Replace(Res, "\t")

RegExp.Pattern = "\r"
Res = RegExp.Replace(Res, "\r")

RegExp.Pattern = "\s"
Res = RegExp.Replace(Res, "\s")

Set RegExp = Nothing
TextToPattern = Res
End Function
</code>

Något mer? =)

Mvh,
Thomas

Tackar!

Inget mer jag stött på ännu, men nu törs jag nog snart inte be om mer heller... ;)

Be på bara, är bara intressant att se vart funktionens "möjligheter" tar oss ;)

Mvh,
Thomas

Hittade exempel på en länk som inte går:

Mjölby kommuns industrihistoria - produkt & bild"

Verkar vara bindestrecket i länknamnet som orsakar det, för utan det går det.
Nåt du kan fixa? :)

Nu börjar det bli en hel del postningar här ;)
Här är koden för att fixa till problemet...

<code>
Function ActivateLinks(Text)
'Funktionen skapad av Thomas Vanhaniemi (thomas@eurocitynet.nu)
'Skapad 20/6 2004
'All användning tillåten

Dim RegExp
Dim Spacer
Dim SpacerPattern
Set RegExp = New RegExp

Spacer = "-%|%-"
SpacerPattern = TextToPattern(Spacer)

RegExp.Global = True
RegExp.IgnoreCase = True

'Möblera om de färdiga länkarna
RegExp.Pattern = "<a([\w\W]*?)\s+href=\s*""\s*([^""]+?)\s*""([\w\W]*?)\s*>([\w\W]*?)</a>"
Text = RegExp.Replace(Text, "$4")

'Ersätt alla mellanslag med "%20" i alla existerande länkar
Dim Match, Matches
RegExp.Pattern = "<a\shref=""[^""\?]+"
Set Matches = RegExp.Execute(Text)
For Each Match In Matches
Text = Replace(Text, Match.Value, "<a " & Replace(Match.Value, " ", "%20", 4), 1, 1)
Next

'Radera redan länkad e-post
RegExp.Pattern = "<a\s+href=""mailto:([^""]+)""([^>]*)>([\w\W]*?)</a>"
Text = RegExp.Replace(Text, vbCrLf & "$1 " & Spacer & "$2" & Spacer & "$3" & Spacer & vbCrLf)

'Radera redan länkade externa länkar
RegExp.Pattern = "<a\s+href=""((?:https?://|ftps?://)[^""]+)""([^>]*)>([\w\W]*?)</a>"
Text = RegExp.Replace(Text, vbCrLf & "$1 " & Spacer & "$2" & Spacer & "$3" & Spacer & vbCrLf)

'Ersätt länkar
RegExp.Pattern = "(^|\s|>)(?:(https?)://|(ftp)s?://)([^\s<]+)"
Text = RegExp.Replace(Text, "$1$2$3://$4")

'Ersätt www länkar
RegExp.Pattern = "(^|\s|>)(www\.[^\s<]+)"
Text = RegExp.Replace(Text, "$1$2")

'Ersätt ftp länkar
RegExp.Pattern = "(^|\s|>)(ftps?\.[^\s<]+)"
Text = RegExp.Replace(Text, "$1$2")

'Ersätt e-post adresser
RegExp.Pattern = "(^|\s|>)([^\s""\|>]+@[^\s<\|]+)"
Text = RegExp.Replace(Text, "$1$2")

'Fixa till eventuella namn på länkar med target angett
RegExp.Pattern = "(?:\r\n)\2\s" & SpacerPattern & "(.*?target="".*?"".*?)" & SpacerPattern & "(.*?)" & SpacerPattern & "(?:\r\n)"
Text = RegExp.Replace(Text, "$4")

'Fixa till eventuella namn på länkar utan target angett
RegExp.Pattern = "(?:\r\n)\2\s" & SpacerPattern & "(.*?)" & SpacerPattern & "(.*?)" & SpacerPattern & "(?:\r\n)"
Text = RegExp.Replace(Text, "$4")

Set RegExp = Nothing
ActivateLinks = Text
End Function

Function TextToPattern(Text)
'Funktionen skapad av Thomas Vanhaniemi (thomas@eurocitynet.nu)
'Skapad 20/6 2004
'All användning tillåten

Dim RegExp
Dim Res
Set RegExp = New RegExp

RegExp.Global = True
RegExp.IgnoreCase = True

RegExp.Pattern = "([\.\+\?\*\[\]\{\^\$\|\(\)\\])"
Res = RegExp.Replace(Text, "\$1")

RegExp.Pattern = "\n"
Res = RegExp.Replace(Res, "\n")

RegExp.Pattern = "\t"
Res = RegExp.Replace(Res, "\t")

RegExp.Pattern = "\r"
Res = RegExp.Replace(Res, "\r")

RegExp.Pattern = "\s"
Res = RegExp.Replace(Res, "\s")

Set RegExp = Nothing
TextToPattern = Res
End Function
</code>

Mvh,
Thomas