"Senden als" VBA Problemchen

30/05/2008 - 13:22 von Hans Otany | Report spam
Hallo,

dank Peter Marchert und anderen dieser NG setze ich erfolgreich u.g. Script
ein um im "Von" Feld des Outlook eine Standard Adresse beim verfassen einer
neuen Mail darin stehen zu haben. Weiterhin sucht es mir beim antworten
gleich den richtigen (meiner beiden) Empfànger raus an den die Mail ging und
setzt den in das "Von" Feld als Absender der Antwort.

Ich habe nur noch ein kleines Problem. Wenn eine Mail an mich und mehrere
Leute in CC ging, dann steht nun beim antworten immer der als Absender
drinn, welcher als erstes in der CC Zeile steht und das bin ich nie, da dort
wohl alphabetisch sortiert wird.
Ich glaube es liegt an der (1) in folgender Zeile aber ich weiß nicht wie
ich das àndern könnte.

objItem.SentOnBehalfOfName Outlook.ActiveExplorer.Selection(1).Recipients(1).Address

Wenn meine Annahme richtig ist, könnte man vieleicht statt der 1 irgendwas
wie "instr((meine 1. Adresse) or (meine 2. Adresse), in CC-Feld)" oder so
etwas àhnliches machen?
Oder kann mir jemand einen Tip geben?


Vielen Dank.

mfg Hans



Code:

Private WithEvents objInspectors As Outlook.Inspectors

Private Sub Application_Startup()
Set objInspectors = Outlook.Inspectors
End Sub

Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
Dim objItem As Object
Dim strSubject As String
Set objItem = Inspector.CurrentItem

'Abfrage nach neuer Mail
'If InStr(LCase(objItem.MessageClass), "ipm.note") Then
'objItem.SentOnBehalfOfName = "<neu@firma.com>"
'objItem.Recipients.ResolveAll
'End If


If InStr(LCase(objItem.MessageClass), "ipm.note") Then

strSubject = LCase(objItem.Subject)

If InStr(strSubject, "aw:") Or InStr(strSubject, "wg:") _
Or InStr(strSubject, "re:") Or InStr(strSubject, "fw:") Then

objItem.SentOnBehalfOfName Outlook.ActiveExplorer.Selection(1).Recipients(1).Address

ElseIf strSubject = "" Then

objItem.SentOnBehalfOfName "<neue_mail_standardadresse@firma.com>"

End If

objItem.Recipients.ResolveAll

End If

Set objItem = Nothing
Set Inspector = Nothing

End Sub

Private Sub Application_Quit()
Set objInspectors = Nothing
End Sub
 

Lesen sie die antworten

#1 Peter Marchert
30/05/2008 - 16:20 | Warnen spam
On 30 Mai, 13:22, "Hans Otany" wrote:

dank Peter Marchert und anderen dieser NG setze ich erfolgreich u.g. Script
ein um im "Von" Feld des Outlook eine Standard Adresse beim verfassen einer
neuen Mail darin stehen zu haben. Weiterhin sucht es mir beim antworten
gleich den richtigen (meiner beiden) Empfànger raus an den die Mail ging und
setzt den in das "Von" Feld als Absender der Antwort.

Ich habe nur noch ein kleines Problem. Wenn eine Mail an mich und mehrere
Leute in CC ging, dann steht nun beim antworten immer der als Absender
drinn, welcher als erstes in der CC Zeile steht und das bin ich nie, da dort
wohl alphabetisch sortiert wird.
Ich glaube es liegt an der (1) in folgender Zeile aber ich weiß nicht wie
ich das àndern könnte.



Hallo Hans,

ja, das liegt an dieser 1. Damit wird der 1. Empfànger der E-Mail
zurückgegeben. Du kannst einmal folgenden Code probieren (habe wenig
Zeit und daher nicht getestet):

Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)

Dim objItem As Object
Dim strSubject As String
Dim strFrom As String

Set objItem = Inspector.CurrentItem

If InStr(LCase(objItem.MessageClass), "ipm.note") Then

strSubject = LCase(objItem.Subject)

If InStr(strSubject, "aw:") Or InStr(strSubject, "wg:") _
Or InStr(strSubject, "re:") Or InStr(strSubject, "fw:")
Then

strFrom GetRecipient(Outlook.ActiveExplorer.Selection(1).Recipients)
If strFrom <> "" Then objItem.SentOnBehalfOfName = strFrom

ElseIf strSubject <> "" Then

objItem.SentOnBehalfOfName = ""

End If

objItem.Recipients.ResolveAll

End If

Set objItem = Nothing
Set Inspector = Nothing

End Sub

Private Function GetRecipient(objRecipients As Outlook.Recipients) As
String

Dim objRecipient As Outlook.Recipient

On Error Resume Next

For Each objRecipient In objRecipients

If objRecipient.Address = "" Then
GetRecipient = ""
ElseIf objRecipient.Address = "" Then
GetRecipient = ""
End If

Next

Set objRecipient = Nothing
Set objRecipients = Nothing

End Function

Gruß
Peter

Infos, Workshops & Software für
Outlook®: www.outlook-stuff.com

Ähnliche fragen