Udvælge alle e-mails i et tekstfelt

Hvis du laver funtionen sådan den ligger dem ind i en streng og skiller hver email adresse med et tegn som ";" ("eamil1;email2;...;emailn") så kan du lave et loop som looper igennem et array med email adresser:


emaillist = LinkString(inputstring)
emailArr = Split(emaillist,";")
for i = 0 to ubound(emailArr)
  emailAdresse = emailArr(i)

  'Send mailen her

next

Hej!

Nu har jeg lagt den ind i mailinglisten således:

Jeg får dog nu en fejl nederst i Loop????

Microsoft VBScript compilation error '800a040e'

'loop' without 'do'

<%

on error resume next
  Do While Not kunderne.EOF
 
    emaillist = LinkString(clienterne.Fields.Item("Kemail"))
    emailArr = Split(emaillist,";")
    for i = 0 to ubound(emailArr)
  emailAdresse = emailArr(i)

  soverskrift = request.form("overskrift")
  standardtext = request.form("beskrivelse")
 
 
  Dim ThisURL
  ThisURL = "http://" & Request.ServerVariables("SERVER_NAME") & _
  Request.ServerVariables("PATH_INFO")
  ThisURL = "http://www.smz.dk"
 
  Set JMail          = Server.CreateObject("JMail.SMTPMail")
  JMail.ServerAddress = "localhost"
  JMail.Sender        = "info@smz.dk"
  JMail.SenderName      = "Smz"
  JMail.ContentType  = "text/plain"
  JMail.Subject      = soverskrift
  JMail.AddRecipient  =  emailAdresse
  JMail.Priority      = 3
  JMail.AddHeader    "Originating-IP", Request.ServerVariables("REMOTE_ADDR")
 
  JMail.Body = JMail.Body & soverskrift & VbCrLf
  JMail.Body = JMail.Body & "--------------------------------------------------------" & VbCrLf & VbCrLf 
  JMail.Body = JMail.Body & standardtext  & VbCrLf & VbCrLf
  JMail.Body = JMail.Body & "Besøg os online på adressen: " & ThisURL & VbCrLf & VbCrLf

  JMail.Execute
 
  Set JMail = Nothing
 
  kunderne.MoveNext
  Loop
      response.redirect("mailsent.asp")
%>

Det den udskriver er jo også hele hyperlinket!!  hvordan kan man få dette fjernet??

arrReplaceString = Array(" <a href='mailto:$1'>$1</a> ", _
  " <a href='$1$2' target='_blank'>$1$2</a> ", _
  " <a href='http://$2' target='_blank'>$2</a> ")

Prøv at rette funktionen til dette her hedder funktionen findEmail:


Function findEmail(strInput)
  dim sPattern, Rx, Match, Matches, RetStr
  sPattern = "([\w\._-]+@[\w\._-]+\.[A-Za-z]{2,4}\S*)"
  Set Rx = New RegExp
  Rx.Global = True
  Rx.IgnoreCase = True
  Rx.Pattern  = sPattern
  Set Matches = Rx.Execute(strInput)
  For Each Match in Matches 
    RetStr = RetStr & ";" & Match.Value
  Next
  Set Rx = Nothing
  RetStr = Mid(RetStr,2) 'Fjerner første ;
  findEmail = RetStr
End Function

Nu virker det!  tusinde tak!!

Ok så får du et svar fra mig ;)

Undskyld det har taget så lang tid!!