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
