Controle email domein bij verzenden bericht

[Geschuffelde]

Hi – ik werk voor meerdere klanten vanaf een ander email domein. Ik heb vorig jaar onderstaand VBA script laten maken om te zorgen dat ik emails vanaf het juiste domein account verstuur – en dat werkt echt heel mooi! Ik wil echter niet altijd de drie letter code van de client [xxx] toevoegen aan het onderwerk maar hij mag ook in de de body van het bericht staan. Hoe pas ik dan aan?

Thanks!

------------

Option Explicit
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim strSubject As String 'Full string containing subject of this message
Dim strFromAccount As String 'Account name to be used for current message
Dim strFromAccountDomain As String 'E-mail domain used in this message

Dim intLeftBracket As Integer 'Position of left bracket
Dim intRightBracket As Integer 'Position of right bracket

Dim strSubjectCode As String 'Subject code as found in the subject

Dim ynCodeAccountMatch As Boolean 'Does code in subject match the current account

strSubject = Item.Subject 'Get subject of current message
strFromAccount = Item.SendUsingAccount.DisplayName 'Get account name for current message
strFromAccountDomain = Right(strFromAccount, Len(strFromAccount) - InStr(1, strFromAccount, "@")) 'Get domain name from e-mail address

intLeftBracket = InStr(1, strSubject, "[", vbTextCompare) 'Find first bracket, start on beginning of subject
intRightBracket = InStrRev(strSubject, "]", -1) 'Find last bracket, start from end of subject

If intLeftBracket = 0 Or intRightBracket = 0 Then
'Subjectcode could not be determined, ask user what to do...
If MsgBox("Geen code ontdekt in het onderwerp van dit bericht. Wilt u dit bericht toch verzenden met het account " & strFromAccount & "?", 36, "Pas op") = vbNo Then
Cancel = True
Exit Sub
Else
Exit Sub
End If
End If

'Get the actual subject code, this is the text between first and last bracket
strSubjectCode = Right(strSubject, Len(strSubject) - intLeftBracket)
intRightBracket = InStrRev(strSubjectCode, "]", -1)
strSubjectCode = Left(strSubjectCode, intRightBracket - 1)

ynCodeAccountMatch = False

'Verify which account should be used for a certain code
Select Case UCase(strSubjectCode)

'Code for bluxxxxx.nl
Case "BMS", "BFA", "D53", "FIS", "FLM", "JCS", "LKA", "MPS", "PIB", "SMT", "TYL"
If LCase(strFromAccountDomain) = "bluxxxxx.nl" Then
ynCodeAccountMatch = True
Else
ynCodeAccountMatch = False
End If

'Code for marxxxxx.nl
Case "1WB", "AZA", "BEN", "BLO", "GHI", "BWS", "ALI", "KAR", "MAR", "MNA", "NIK", "PEO", "SCS", "SCV", "TUI", "WDG"
If LCase(strFromAccountDomain) = "marxxxxx.nl" Then
ynCodeAccountMatch = True
Else
ynCodeAccountMatch = False
End If
End Select

If ynCodeAccountMatch = False Then

If MsgBox("Bericht met code " & UCase(strSubjectCode) & " hoort wellicht niet bij account " & strFromAccount & "." & vbCrLf & vbCrLf & "Bericht versturen?", 36) = vbNo Then
Cancel = True
End If

Else
'Code found matches correct domain name. Do not bother user, just send the message
End If

strSubject = ""
strSubjectCode = ""
strFromAccount = ""
strFromAccountDomain = ""

intLeftBracket = 0
intRightBracket = 0

ynCodeAccountMatch = False

End Sub

 

[edmoor]

Maak eeerst je code op met codetags, zo is het nogal vervelend lezen.

 

[snb]

Ik heb vorig jaar onderstaand VBA script laten maken

Dan zou ik eens kontakt met de auteur van de macro opnemen...

 

[OctaFish]

Maak eeerst je code op met codetags, zo is het nogal vervelend lezen.

TS is nog maar 13 jaar lid van HelpMij; dan weet je dat nog niet zo goed .

 

[edmoor]

Ah, vandaar