Avatar billede dreyfusdk Nybegynder
29. november 2006 - 09:24 Der er 4 kommentarer

Funktion til at tjekke om variabel indeholder email adresse

Hej,

Jeg står i den situation at jeg skal have analyseret en række variabler, og hvis de indeholder en email adresse (ingen bestemt, men bare noget der ligner fx. xxx@yyy.zz) så skal den reagere ved at printe den pågældende email adresse den finder.

Helt konkret anvender jeg det i forbindelse med udsending af mit nyhedsbrev. Her har jeg en forholdsvismæssig stor modtagerliste, og jeg vil gerne sortere modtagere fra, hvis emails bouncer tilbage og landet i min c:\inetpub\rootmail\badmail -mappe fra.

Derfor looper jeg alt indhold igennem, i denne mappe, med et asp script, som I lige kan få:

<code>
<%
path = "C:\inetpub\mailroot\badmail\"
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(path)
Set objFiles = objFolder.Files %>
Filer i mappen <b><%=path%></b><hr>
<%
For Each file In objFiles
    response.write file.name & "<br>"
   
    if right(file.name,3) ="BAD" then
        Set objTextStream = objFS.OpenTextFile(path & file.name, 1)
            strIndhold = objTextStream.ReadAll
            ' analyser strIndhold for spor af email adresse (mangler)
        objTextStream.Close
        Set objTextStream = Nothing
    end if
    objFS.DeleteFile(path & file.name)
Next
%>
</code>


Det smarte er naturligvis, at disse badmails samtidig også bliver slettet fra badmail-mappen så jeg ikke skal gøre det manuelt.

Nå... det var lidt offtrack. Jeg har altså brug for en smart funktion, der kan finde noget der ligner emailadresser i en variabel, og returnere det til mig så jeg kan gå ind og fjerne den pågældende modtager fra nyhedsbrevlisten.

Jeg ser frem til at høre fra jer :-)
Avatar billede crysis Nybegynder
29. november 2006 - 09:31 #1
Måske dette kan hjælpe. Skal nok rettes noget til :-) Og ja, køn kode er det ikke. Det kan nok gøres meget bedre med Regex.

Function ScreenString(Text, Email)
    Email = LCase(Email)
    Text = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(LCase(Text), " ", ""), "-", ""), "!", ""), "#", ""), "¤", ""), "%", ""), "&", ""), "/", ""), "(", ""), ")", ""), "=", ""), "´", ""), "|", "¨"), "^", ""), "'", ""), "_", ""), ",", ""), "<", ""), ">", ""), "\", ""), ".", ""), ":", ""), ";", ""), "£", ""), "$", ""), "{", ""), "[", ""), "]", ""), "}", ""), "+", ""), "`", "")
    'Response.Write(Email & "<br>" & Text)
   
    Dim Username
    Dim Domain
    Dim Country   
    Dim MidPosition
    Dim DotPosition
    MidPosition = InStr(Email, "@")
    DotPosition = InStrRev(Email, ".")
    Username = Left(Email, MidPosition-1)
    Domain = Mid(Email, MidPosition+1, DotPosition - (MidPosition+1))
    Country = Mid(Email, DotPosition+1, Len(Email) - (DotPosition))

    LikeMSN1 = InStr(Text, Username)
    LikeMSN2 = InStr(Text, Domain)
    LikeMSN3 = InStr(Text, "hotcom")   
    LikeMSN4 = InStr(Text, "." & Country)
    LikeMSN5 = InStr(Text, "@")
    LikeMSN6 = InStr(Text, "hotmail")
    LikeMSN7 = InStr(Text, "hotmai")
    LikeMSN8 = InStr(Text, ".dk")

    'Response.Write(Username & "-" & Domain & "-" & Country & "-" & "Username: " & LikeMSN1 & " Domain:" & LikeMSN2 & " Country:" & LikeMSN4 & " HotCom" & LikeMSN5)
   
    If (LikeMSN1 = 0 or LikeMSN2 = 0) and LikeMSN3 = 0 and LikeMSN6 = 0 and LikeMSN5 = 0 and LikeMSN7 = 0 and LikeMSN8 = 0 THEN
        ScreenString = 0
    ELSE
        ScreenString = 1
    END IF
End Function
Avatar billede dreyfusdk Nybegynder
29. november 2006 - 09:42 #2
Mja, nu ser det ikke ud som om, den returnere de eventuelle email adresser der måtte være nævnt i teksten.

Er der andre der har et bud?
Avatar billede cpufan Juniormester
30. november 2006 - 23:54 #3
posofsnabela = Instr(strIndhold)
if posofsnabela > 0 then
firstpart = left(strindhold,posofsnabela)
mellemrum1 =0
for i=1 to posofsnabela
if mid(firstpart,i,1) = " " then mellemrum1 = i
next
end if
mellemrum2 = Instr(right(strindhold,len(strindhold)-posofsnabela-1)," ")
emailadresse = mid(strindhold,mellemrum2-mellemrum1,mellemrum1+1)
Avatar billede cpufan Juniormester
30. november 2006 - 23:55 #4
hov

posofsnabela = Instr(strIndhold,"@")
if posofsnabela > 0 then
firstpart = left(strindhold,posofsnabela)
mellemrum1 =0
for i=1 to posofsnabela
if mid(firstpart,i,1) = " " then mellemrum1 = i
next
end if
mellemrum2 = Instr(right(strindhold,len(strindhold)-posofsnabela-1)," ")
emailadresse = mid(strindhold,mellemrum2-mellemrum1,mellemrum1+1)
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester



Seneste spørgsmål Seneste aktivitet
I dag 06:10 Excel åbner fil i kæmpe format Af Aske i Excel
I går 22:00 Datafordeler Af Lsk i PHP
I går 12:37 Summere beløb pr. dato Af TTA i Excel
31/1022:44 Tilslutte chassic fans Af viking69 i PC
31/1020:28 LED lysstofrør Af ErikHg i Fri debat