Hallo Zusammen, ich habe ein folgendes Problem. Ich will Email direkt in eine Excel Datei verschicken - soweit so gut. Aber zwei Sachen möchte ich noch verbessern:
- Als Grundlage damit der Skript startet, muss im Betreff "****" enthalten sein:
Der Betreff wird dann in eine Zelle übernommen:
Kann ich irgendwas machen, damit der Betreff ohne die Sterne übernommen wird? Evtl. kann man auch irgendwie die Zellen im Excel formatieren, dass nur der Text angezeigt wird, aber ich habe nichts gefunden...
- Mein Größeres Problem ist aber, dass der Body mit Signatur mitübernommen wird:
In die Zelle soll eben nur der Inhalt der Email übernommen werden, ohne jegliche Signaturen usw. Nur das was in der ersten Zeile steht.
- Als Grundlage damit der Skript startet, muss im Betreff "****" enthalten sein:
Der Betreff wird dann in eine Zelle übernommen:
Kann ich irgendwas machen, damit der Betreff ohne die Sterne übernommen wird? Evtl. kann man auch irgendwie die Zellen im Excel formatieren, dass nur der Text angezeigt wird, aber ich habe nichts gefunden...
- Mein Größeres Problem ist aber, dass der Body mit Signatur mitübernommen wird:
In die Zelle soll eben nur der Inhalt der Email übernommen werden, ohne jegliche Signaturen usw. Nur das was in der ersten Zeile steht.
Visual Basic-Quellcode
- Option Explicit
- 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
- End Sub
- Private Sub olitems_itemadd(ByVal items As Object)
- 'Variablen dimensionieren
- Dim olMail As Outlook.MailItem
- 'Prüfen, ob item eine Mail ist
- If TypeName(items) = "MailItem" Then
- Set olMail = items
- 'Prüfen, ob die Mail verwendet werden kann
- If InStr(olMail.Subject, "****") <> 0 Then
- 'Variablen
- Dim xlApp As New Excel.Application
- Dim wbMaster As Workbook
- Dim wsMaster As Worksheet
- 'Excel - Applikation sichtbar machen
- xlApp.Visible = False
- 'Datei öffnen,
- Set wbMaster = xlApp.Workbooks.Open("C:\Users\ge405062\Desktop\LOK_LOGBUCH.xlsm")
- Set wsMaster = wbMaster.Worksheets(1)
- 'Daten kopieren und einfügen
- wsMaster.UnProtect Password:="Lok"
- wsMaster.Range("B" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row + 1) = olMail.ReceivedTime
- wsMaster.Range("A" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row + 1) = "=WEEKNUM(RC[1])"
- wsMaster.Range("c" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row) = olMail.Subject
- wsMaster.Range("d" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row) = olMail.Body
- wsMaster.Range("e" & wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row) = olMail.Sender
- wsMaster.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
- , AllowFiltering:=True, Password:="Lok"
- 'Dateien und Applikation schließen
- wbMaster.Close True
- xlApp.Quit
- End If
- End If
- End Sub