Om jag har flera länkar o vill ersätta dem med t ex Link.asp?id=1 osv, hur gör jag det enklast, länkarna ligger blandat med en massa html kod o alla länkar är olika! Regular expresions(regexp) ger dig möjlighet att plocka ut och ersätta information i en text. Jo jag vet...men det går väl inte i ett sådant här fall? Jag fick inte till det iaf! Det går alldeles utmärkt. Tyvärr hinner jag inte nu hjälpa dig skriva de "rugulära uttrycket". Sitter i skolan och läser motorstyrning. Brum, brum. Fast med elmotorer. Denna funktion kommer fungera med de tagar du angivit här. Om du vill ha mer intiligens i din funktion rekomentderar jag att du istället använder DOM - Document Object Model:ersätt Url länk med något annat
Länkar kan vara vad som helst t ex
Vill att det ska stå så här istället Sv: ersätt Url länk med något annat
Sv: ersätt Url länk med något annat
Sv: ersätt Url länk med något annat
Sv: ersätt Url länk med något annat
<code>
Function TranslateURL(Value)
Select Case Value
Case "http://www.aftonbladet.se"
TranslateURL = "link.asp?id=1.asp"
Case "test.asp"
TranslateURL = "link.asp?id=2.asp"
Case Else
TranslateURL = Value
End Select
End Function
Function EscapeRegExp(Value)
Dim RegExp
Set RegExp = New RegExp
RegExp.Global = True
RegExp.IgnoreCase = True
RegExp.Pattern = "(" + _
"\[" + "|" + _
"\\" + "|" + _
"\^" + "|" + _
"\$" + "|" + _
"\." + "|" + _
"\|" + "|" + _
"\?" + "|" + _
"\*" + "|" + _
"\+" + "|" + _
"\(" + "|" + _
"\)" + _
")"
EscapeRegExp = RegExp.Replace(Value, "\$1")
End Function
Public Function ReplaceLinks(Value)
Dim RegExp
Dim url
Dim Match
Dim Matches
Set RegExp = New RegExp
RegExp.Global = True
RegExp.IgnoreCase = True
'RegExp.Pattern = "<\s*a\s.*href/s*=/s*""?(.*)""?.*>"
RegExp.Pattern = "href\s*=\s*""([^""]*)"""
Set Matches = RegExp.Execute(Value)
ReplaceLinks = Value
For Each Match In Matches
url = Match.SubMatches(0)
RegExp.Pattern = "(href\s*=\s*"")" & EscapeRegExp(url) & "("")"
ReplaceLinks = RegExp.Replace(ReplaceLinks, "$1" & TranslateURL(url) & "$2")
Next
End Function
</code>
Det framkommer inte vilket ID sidorna skall ha. Jag antar att du kommer lägga dessa i en databas och ge dem ett ID. Du kan själv anpassa TranslateURL() funktionen. T. Ex. Kontrollera mot en databas och bara lägga till de som saknas.Sv: ersätt Url länk med något annat
<code>
Function ReplaceLinks(Value, NoMailTo)
Dim Doc
Dim Element
Dim HRef
Set Doc = CreateObject("Microsoft.XMLDOM")
Doc.loadXML "<body>" & Value & "</body>"
If Doc.parseError.errorCode Then
Else
Doc.setProperty "SelectionNamespaces", "xmlns:xsl='http://www.w3.org/1999/XSL/Transform'"
Doc.setProperty "SelectionLanguage", "XPath"
If NoMailTo Then
For Each Element In Doc.selectNodes("//a|//A")
HRef = Element.GetAttribute("href")
If LCase(Left(HRef, 7)) = "mailto:" Then
Else
Element.setAttribute "href", TranslateUrl(HRef)
Debug.Print Element.Text
End If
Next
Else
For Each Element In Doc.selectNodes("//a|//A")
Element.setAttribute "href", TranslateUrl(Element.GetAttribute("href"))
Debug.Print Element.Text
Next
End If
End If
ReplaceLinks = Doc.xml
ReplaceLinks = Mid(ReplaceLinks, 7, Len(ReplaceLinks) - 15)
End Function
Sub TestReplaceLinks()
Const strText = "Getta är en länk till Aftonbladet." & vbCrLf & _
"Här är Test sidan." & vbCrLf & _
"Du kan maill bill på: bill@microsoft.com"
Debug.Print ReplaceLinks(strText, True)
End Sub
</code>
Detta förutsätter att din text inte innehåller ogiltliga taggar. Om så är fallet. KAn du först "tvätta/strippa" bort dessa med regexp. Innan du parsar.