Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1428to1432
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Outlook Daten in Excel eintragen

VBA Outlook Daten in Excel eintragen
28.05.2015 16:11:32
Simon
Hallo,
ich fange gerade mit Outlook VBA und Excel ein. Möchte eine E-Mail von Outlook nach Excel übertragen.
Das klappt soweit auch ganz gut, bis auf ein paar Einschränkungen.
Erstmal mein Code:
Option Explicit

Sub CopyToExcel()
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim olItem As Outlook.MailItem
Dim vText As Variant
Dim sText As String
Dim vItem As Variant
Dim oRng As Range
Dim i As Long
Dim rCount As Long
Dim bXStarted As Boolean
Dim myTime As String
Const strPath As String = "\\xxxxxxxxx\ixxxxx\XXXX\xxxxx\xxxxxxxx\Auftrag.xlsx" 'the path of  _
the workbook
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox "No Items selected!", vbCritical, "Error"
Exit Sub
End If
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err  0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Q1 2015")
'Process each selected record
For Each olItem In Application.ActiveExplorer.Selection
sText = olItem.Body
vText = Split(sText, Chr(13))
'Find the next empty line of the worksheet
rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(xlUp).Row
rCount = rCount + 1
'Check each line of text in the message body
For i = UBound(vText) To 0 Step -1
If InStr(1, vText(i), "Kundennummer:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("A" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Tarif") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("B" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Eingabedatum") > 0 Then
vItem = Split(vText(i), Chr(58))
myTime = olItem.ReceivedTime
xlSheet.Range("A" & rCount) = myTime
xlSheet.Range("C" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Widerruf") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("H" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Termin") > 0 Then
vItem = Split(vText(i), Chr(58))
myTime = olItem.ReceivedTime
xlSheet.Range("J" & rCount) = Trim(vItem(1))
End If
Next i
xlWB.Save
Next olItem
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
Set olItem = Nothing
End Sub

Mein Problem: Es wird immer nur die aktuellste E-Mail in Excel übertragen. Es sollen aber alle E-Mails ausgelesen werden. Weiß jemand wie ich das schreibe?
Problem Nummer 2: Die E-Mail soll einen Betreff haben, dies geht aber mit dem Code da oben nicht. Weiß jemand wie ich einen bestimmten Betreff hinzufügen kann?
Problem Nummer 3:
Bei diesem Code: Hier steht in der E-Mail ein Datum. Dieser wird auch richtig in Excel eingegeben, allerdings von Excel erst dann als Datum erkannt, wenn ich einmal in die Zelle reinklicke. Vorher scheint es für Excel nur eine Zahl zu sein.
If InStr(1, vText(i), "Termin") > 0 Then
vItem = Split(vText(i), Chr(58))
myTime = olItem.ReceivedTime
xlSheet.Range("J" & rCount) = Trim(vItem(1))
End If
Wenn mir hier jemand helfen kann, dann wäre euch sehr sehr dankbar.

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Outlook Daten in Excel eintragen
28.05.2015 20:03:31
mumpel
Hallo!
Das wird schwierig wenn Du kein VBA kannst. Um alle Emails auszulesen muss man eine Schleife einbauen.
Hier mal ein Beispiel wie man alle Emails im angegebenen Ordner ansprechen kann.
Dim olApp          As Outlook.Application
Dim olName         As Outlook.Namespace
Dim olFolder       As Outlook.MAPIFolder
Dim Items          As Outlook.Items

Dim iInt           As Long

Dim lngItemsCount  As Long


   
   Set olApp = Application
   Set olName = olApp.GetNamespace("MAPI")
   Set olFolder = olName.Session.Folders("RMH Software").Folders("Posteingang")
   

       Set Application.ActiveExplorer.CurrentFolder = olFolder
           Set Items = olFolder.Items
               For iInt = Items.Count To 1 Step -1
                   Rem Hier der Code zum Auslesen 
               Next iInt

VBA/HTML - CodeConverter für Office-Foren, AddIn für Office 2002-2013 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:mumpel

Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0

Du solltest Dich erstmal mit VBA befassen. Sonst wird es eine schwere Arbeit für mich/uns.
Gruß, René

Anzeige
AW: VBA Outlook Daten in Excel eintragen
28.05.2015 20:46:51
mumpel
Zu Problem 3: Die Zellen bereits vorher (standardmäßig) als Datum formatieren.
Zu Problem 2: Wie genau meinst Du das?
Zu Problem 1: Auf die Schnelle mal eine Anpassung für alle Emails im angegebenen Ordner (Ordnernamen musst Du noch anpassen). Der Code ist ungetestet.
Sub CopyToExcel()

Dim olApp          As Outlook.Application
Dim olName         As Outlook.Namespace
Dim olFolder       As Outlook.MAPIFolder
Dim olItems        As Outlook.MailItem

Dim xlApp          As Excel.Application
Dim xlWB           As Excel.Workbook
Dim xlSheet        As Excel.Worksheet

Dim vText          As Variant
Dim vItem          As Variant

Dim iInhalt        As Long
Dim rCount         As Long
Dim iInt           As Long

Dim myTime         As String
Dim sText          As String
Const strPath      As String = "C:\Auftrag.xlsx"
  
   
   Set olApp = Application
   Set olName = olApp.GetNamespace("MAPI")
   Set olFolder = olName.Session.Folders("RMH Software").Folders("Posteingang")
   
       On Error Resume Next
           Set xlApp = GetObject(, "Excel.Application")
               If Err <> 0 Then Set xlApp = CreateObject("Excel.Application")
       On Error GoTo 0
           Set xlWB = xlApp.Workbooks.Open(strPath)
           Set xlSheet = xlWB.Sheets("Q1 2015")
                 Set Application.ActiveExplorer.CurrentFolder = olFolder
                     Set olItems = olFolder.Items
                         For iInt = olItems.Count To 1 Step -1
                             sText = olFolder.Items(iInt).Body
                             vText = Split(sText, Chr(13))
                             rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(xlUp).Row + 1
                             For iInhalt = Ubound(vText) To 0 Step -1
                                 If InStr(1, vText(iInhalt), "Kundennummer:") > 0 Then
                                    vItem = Split(vText(iInhalt), Chr(58))
                                    xlSheet.Range("A" & rCount) = Trim(vItem(1))
                                 End If
                                 If InStr(1, vText(iInhalt), "Tarif") > 0 Then
                                    vItem = Split(vText(iInhalt), Chr(58))
                                    xlSheet.Range("B" & rCount) = Trim(vItem(1))
                                 End If
                                 If InStr(1, vText(iInhalt), "Eingabedatum") > 0 Then
                                    vItem = Split(vText(iInhalt), Chr(58))
                                    myTime = olFolder.Items(iInt).ReceivedTime
                                    xlSheet.Range("A" & rCount) = myTime
                                    xlSheet.Range("C" & rCount) = Trim(vItem(1))
                                 End If
                                 If InStr(1, vText(iInhalt), "Widerruf") > 0 Then
                                    vItem = Split(vText(iInhalt), Chr(58))
                                    xlSheet.Range("H" & rCount) = Trim(vItem(1))
                                 End If
                                 If InStr(1, vText(iInhalt), "Termin") > 0 Then
                                    vItem = Split(vText(iInhalt), Chr(58))
                                    myTime = olFolder.Items(iInt).ReceivedTime
                                    xlSheet.Range("J" & rCount) = Trim(vItem(1))
                                 End If
                             Next iInhalt
                         Next iInt
               xlWB.Save
End Sub

VBA/HTML - CodeConverter für Office-Foren, AddIn für Office 2002-2013 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:mumpel

Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0


Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige