Einzelne Emails per Makro weiterleiten

Hallo, folgendes Problem.

Ich möchte einzelne Emails per Knopfdruck mit einem Makro an eine bestimmte Adresse weiterleiten. Genutzt wird Outlook 2003. Kann mir da jemand einen vorgefertigten VBA Code geben? Bin für jede Hilfe dankbar.

mfg

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 67753

Url: https://administrator.de/forum/einzelne-emails-per-makro-weiterleiten-67753.html

Ausgedruckt am: 23.12.2024 um 12:12 Uhr

22 Kommentare

Neuester Kommentar

Hi,

hier findest du ein passenden Add-In dazu.

Psycho

P.S. Das Forum hat eine klasse Suchfunktion!

Die hab ich genutzt. Die Add-In Seite hab ich schon gefunden, nur ist nichts passendes dabei was mir bei meinem Problem weiterhilft, welches Add-In meinst du speziell? Ich finde dort nur eines um Termin- und Aufgabenlisten weiterzuleiten, mehr nicht.

Hi,

wurschtel dich mal durch! Die haben ein Add-In, welches eine ComboBox in der Symbolleiste platziert. Über diese Leiste wählst du dann den Empfänger für die Weiterleitung aus. Frag mich jetzt nicht, wied das Teil heisst.

Psycho

Entweder ich bin blind oder das Add-In ist nicht auffindbar. Hat denn keiner einen VBA Code für sowas?

So, hab mich selbst rangesetzt und ein Makro geschrieben, funktioniert wunderbar. Bei Interesse kann ich euch den Code zur Verfügung stellen.

mfg

Hi,
ich würde mich für den Code interessieren

Würde mir bei meinem Problem auch weiterhelfen

Emails per Makro an andere Adresse weiterleiten (Outlook 2003)

Aufgrund des allgemeinen Interesses hier mal der Code ^^

Sub test()

Dim objMail_In As Outlook.MailItem

Dim objMail_Out As Outlook.MailItem

Set objMail_In = ActiveInspector.CurrentItem

Set objMail_Out = objMail_In.Forward

With objMail_Out

.To = "email@domain.de" '<- Hier noch Empfänger eintragen

.Subject = "weitergeleitet: " & objMail_In.Subject

.Send

End With

End Sub

Nicht vergessen den Empfänger einzutragen!
Viel Spaß damit

mfg

Moin!

@Mark41:
ich muß mich wohl bei dir entschuldigen! Aber als ich auf den ursprünglichen Thread geantwortet habe, gab es dieses Add-In noch auf der Seite. Mittlerweile ist es wohl aus dem Programm verschwunden.
Freut mich, dass du es auch so hinbekommen hast!

Psycho

Hi,

kein Problem, habs ja letztendlich doch hinbekommen, das is was zählt, danke für deine Bemühungen!

mfg

Ich habe das Code kopiert und ein Makro erstellt.
Wenn ich dieses jedoch starte, wird der folgende Fehler ausgegeben.

Laufzeitfehler 91
Objektvariable oder With-Blockvariable nicht festgelegt.

Beim Debuggen werdne die Set Zeilen markiert.
Was mache ich falsch?

Hallo,

nutzt du zufällig Kaspersky Antivirensoftware? Gab mal diverse Probleme damit, wüsste sonst auch nicht worans liegen könnte

mfg

Hallo zusammen,

gibt es zu der von 'sideshowbob100' dargestellten Problematik einen Lösungsansatz?
Bei mir ist es dasselbe Problem: 'objMail_In' & 'objMail_Out' werden nicht gesettet..
'Kaspersky Antivirensoftware' wird meinerseits nicht genutzt.
Freue mich über jede Rückmeldung!

Mit freundlichem Gruß

Zitat von @RainerZufalll:
gibt es zu der von 'sideshowbob100' dargestellten Problematik einen Lösungsansatz?

Hier reinschauen:
Outlook 2010 Weiterleiten Makro, Betreff ergänzen, Adresse anpassen

Set objMail_In = ActiveInspector.CurrentItem

Das obige funktioniert nur wenn man ein Mail in einem weiteren Fenster "geöffnet", und nicht nur "markiert" hat! Ansonsten muss man über das Explorer-Objekt und die "Selection" gehen.

Gruß grexit

Moin Grexit,

erstmal vielen Dank für die schnelle, kompetente Rückmeldung!
Hab ich soweit verstanden, leider fehlt mir das VBA-Knowhow um die Selection einzupflegen.

Folgend habe ich meine Zeilen nochmal notiert.

Sub test(oMail As MailItem)

Dim objMail_In As MailItem
Dim objMail_Out As MailItem

Set objMail_In = ActiveInspector.CurrentItem
Set objMail_Out = objMail_In.Forward

With objMail_Out
.To = "x@y.com" 'Empfänger
.Subject = "Test"
.Send
End With

End Sub
____________________________________________

Case "Explorer"
Set myItem = ActiveExplorer.Selection.Item(1)

=> Müssen dies eingepflegt werden?

Viele Grüße

Moin,

bin schon mal ein Stück weitergekommen!
Es werden E-Mails weitergeleitet. Leider noch nicht die Mail, durch die die Regel aufgerufen wird das Skript auszuführen.

Code:

Sub test(oMail As MailItem)

Dim objMail_In As MailItem
Dim objMail_Out As MailItem

Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set myItem = ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set myItem = ActiveInspector.CurrentItem
Case Else
End Select

Set objMail_In = myItem
Set objMail_Out = objMail_In.Forward

With objMail_Out
.To = "x@y.com" 'Empfänger
.Subject = "Test"
.Send
End With

End Sub

Öhm von der Verwendung per Regel war kein Wort erwähnt ... kann ja so auch nicht funktionieren denn du verwendest ja das Mail-Object das per Parameter übegeben wird garnicht...

Sub ForwardMail(objMail As MailItem)
    Dim objForward As MailItem
    Set objForward = objMail.Forward
    With objForward
        .To = "xyz@domain.de"  
        .Subject = "Test"  
        .Send
    End With
End Sub

Gruß grexit

Moin,

vielen Dank soweit! Sorry für die späte Antwort!
Jetzt läuft das automatische Weiterleiten ohne Probleme.
Eine Frage hätte ich aber noch: Kann man beim automatischen Verschieben (Move-Funktion) einer Mail den Zielordner mit einer Pfadbezeichnung angeben?
Etwa

Set Folder = Folders.FolderPath (\\x@y.com\Posteingang\Sonstiges)

oder Ähnliches ?

Danke im Voraus!

Eine Frage hätte ich aber noch: Kann man beim automatischen Verschieben (Move-Funktion) einer Mail den Zielordner mit einer Pfadbezeichnung angeben?

Nein machst du so:

set folder = Application.Session.Stores("x@y.com").GetRootFolder.Folders("Posteingang").Folders("Sonstiges")

usw. jeder Ordner hat sein eigenes Folders-Objekt damit kannst du also beliebig in Unterordner verzweigen.

Soweit implementiert!
Nochmal das Darzustellende kurz kommentiert: In einem Sammelpostfach treffen Mails eines bestimmten Absenders ein & sollen weitergeleitet und verschoben werden. (Regel bei Eintreffen Mail -> Skript ausführen)
Zunächst wird ein Wert aus der Betreffzeile ausgelesen welcher Bestandteil der Mail-Adresse ist, an die die Mail weitergeleitet wird.
Entsprechend wird die Mail weitergeleitet und anschließend soll die Mail in ein Unterordner des Sammelpostfachs verschoben werden.

Habe bereits den Code an meinem "normalen" Postfach getestet - lief einwandfrei.
Beim Sammelpostfach wird die Betreffzeile zwar gekürzt, jedoch keine Mails weitergeleitet oder gar verschoben.

Ne Idee?

Sub Test(oMail As Outlook.MailItem)

 Dim objMail_In           As MailItem
 Dim objMail_Out        As MailItem
 Dim Folder                  As Outlook.MAPIFolder
 Dim SubFolder           As Outlook.Folder
 Dim TestFolder          As Outlook.Folder
 Dim myOlApp             As Outlook.Application
 Dim FolderName       As String
 Dim Ns                        As Outlook.NameSpace
 Dim myEntryID          As String
 Dim myStoreID          As String
 
 
 FolderName = "Sonstiges"  

'NDL-Nummer aus Betreffzeile filtern  
 Dim arr As Variant
 Dim i As Long
  
'Liste der zu entfernenden Begriffe  
 arr = Array("XX", YY")  
  
 For i = 0 To UBound(arr)
    oMail.Subject = Replace(oMail.Subject, arr(i), "", , , vbTextCompare)  
    Next
    If oMail.Saved = False Then
       oMail.Save
    End If

 Select Case TypeName(Application.ActiveExplorer)
 Case "Explorer"  
 Set myItem = oMail
 Case Else
 End Select

 Set objMail_In = myItem
 Set objMail_Out = myItem.Forward
 Set myOlApp = Outlook.Application
 Set Ns = Application.GetNamespace("MAPI")  
 Set Folder = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders(FolderName)  
        myEntryID = Folder.EntryID
        myStoreID = Folder.StoreID
 Set Folder = Application.Session.Stores("x@y.com").GetRootFolder.Folders("Posteingang").Folders("Sonstiges")  
 
 
 With objMail_Out
 .To = "x" & objMail_In.Subject & "@y.com" 'Empfänger  
 .Subject = "XX" & oMail.Subject & "YY"  
 .Body = "Anbei der Orginalanhang."  
 .Send
 End With
 
 With objMail_In
   .Subject = "XX" & oMail.Subject & "YY"  
   .Move Folder
 End With
 
 End Sub