Makro für Outlook bei Mail-Eingang
Inhalt
- Makros freigeben in Outlook
- Übersicht über die Standard Events in Outlook
- Event „Mail Eingang“ initalisieren
- Makro, das beim Mail-Eingang ausgeführt wird
- Test der Prozeduren inkl. Schritt für Schritt Durchlauf
- Bedingungen, dass Makro ausgeführt wird
- Automatisches Speichern von Daten aus Anhängen
- Prozedur DatenZusammenfuehren in Outlook
- Letzte Zeile einer Tabelle auslesen
- Prozedur aus anderem Modul aufrufen
- Schritt für Schritt Testlauf
Code (in ThisOutlookSession)
Private WithEvents olItems As Outlook.Items Private Sub Application_Startup() 'Variablen dimensionieren Dim olApp As Outlook.Application Dim olNS As Outlook.NameSpace 'Variablen initialisieren Set olApp = Outlook.Application Set olNS = olApp.GetNamespace("MAPI") Set olItems = olNS.GetDefaultFolder(olFolderInbox).Items 'Test Debug.Print "Application_Startup wird ausgeführt" End Sub Private Sub olItems_ItemAdd(ByVal item As Object) 'Variablen dimensionieren Dim olMail As Outlook.MailItem Dim olAtt As Outlook.Attachment Dim Dateipfad As String 'Prüfen, ob Item eine Mail ist If TypeName(item) = "MailItem" Then Set olMail = item 'Prüfen, ob Mail verwendet werden soll If InStr(olMail.Subject, "Test") <> 0 And _ olMail.SenderEmailAddress = "kaiweissmann@outlook.de" Then 'Daten zusammenführen 'Schleife über alle Anhänge For Each olAtt In olMail.Attachments Dateipfad = "C:\Users\kaiwe\OneDrive\Desktop\Downloads\" & olAtt.FileName 'Datei speichern olAtt.SaveAsFile Dateipfad 'Daten zusammenführen Call DatenZusammenfuehren(Dateipfad) Next olAtt End If 'Test ' Debug.Print olMail.Subject ' Debug.Print olMail.SenderEmailAddress ' Debug.Print olMail.Attachments.Count End If 'Bereitgestellt von VBATrainer: www.vbatrainer.de End Sub
Code (in Outlook Modul)
Sub DatenZusammenfuehren(Dateipfad As String) 'Excel-Bibliothek aktivieren 'Variablen dimensionieren Dim xlApp As New Excel.Application Dim wbMaster As Workbook Dim wbSource As Workbook Dim wsMaster As Worksheet Dim wsSource As Worksheet 'Excel-Applikation sichtbar machen xlApp.Visible = True 'Dateien öffnen Set wbMaster = xlApp.Workbooks.Open("C:\Users\kaiwe\OneDrive\Desktop\MasterData.xlsx") Set wbSource = xlApp.Workbooks.Open(Dateipfad) Set wsSource = wbSource.Worksheets(1) Set wsMaster = wbMaster.Worksheets(1) 'Daten kopieren und einfügen wsSource.Range("A2:E" & wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row).Copy wsMaster.Range("A" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial 'Dateien und Applikation schließen wbMaster.Close True wbSource.Close False xlApp.Quit 'Bereitgestellt von VBATrainer: www.vbatrainer.de End Sub