E-Mail inhalt mit vba in Excel einfügen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: E-Mail inhalt mit vba in Excel einfügen
von: Simon
Geschrieben am: 28.05.2015 13:39:43

Hallo ihr :)
Ich habe ein VBA-Makro gefunden welches genutzt werden kann um Inhalte einer E-Mail in Excel einzufügen.
Das wollte ich jetzt ausprobieren. Bekomme aber die Fehlermeldung:
"Fehler beim Kompilieren: Benutzerdefinierter Typ nicht definiert."
Wie bekomme ich das weg?
Vielen Dank im Voraus :)
Hier der 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 = "\\HE111168e004\a11949697$\Home\System\Desktop\Mappe.xlsx"
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("Tabelle1")
'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), "Source:") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("A" & rCount) = Trim(vItem(1))
        End If
        If InStr(1, vText(i), "Kundennummer") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("B" & rCount) = Trim(vItem(1))
            myTime = olItem.ReceivedTime
            xlSheet.Range("A" & rCount) = myTime
        End If
        If InStr(1, vText(i), "Produkt") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("C" & rCount) = Trim(vItem(1))
        End If
        If InStr(1, vText(i), "Widerrufsfrist") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("D" & rCount) = Trim(vItem(1))
        End If
        If InStr(1, vText(i), "Termin") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("E" & rCount) = Trim(vItem(1))
        End If
    Next i
    xlWB.Save
Next olItem
xlWB.Close SaveChanges:=True
If bXStarted Then
    xlApp.Quit
End If
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
Set olItem = Nothing
End Sub

Bild

Betrifft: AW: E-Mail inhalt mit vba in Excel einfügen
von: mumpel
Geschrieben am: 28.05.2015 14:02:59
Hallo!
1. Wie lautet die Fehlermeldung?
2. Der Code ist für Outlook-VBA, nicht für Excel-VBA.
3. Du musst in Outlook-VBA einen Verweis auf die "Microsoft Excel 12.0 Object Library" setzen.
Gruß, René

Bild

Betrifft: AW: E-Mail inhalt mit vba in Excel einfügen
von: Simon
Geschrieben am: 28.05.2015 14:25:52
Ah jetzt hat es geklappt.
Sorry meinte auch Outlook.
Also es hat geklappt die Daten in Excel einzupflegen. Allerdings funktioniert das jetzt nur wenn die E-Mail keinen Betreff hat.
Jemand eine Idee was ich einfügen muss damit alle E-Mails mit dem Namen: xyz auch mitgelesen werden?
Und: Wenn jemand noch andere Sachen in der E-Mail vorhanden sind, dann wird in die Excel Tabelle gar nichts eingetragen.
Wie kann ich das verhindern, dass die doch ausgelesen wird?

Bild

Betrifft: AW: E-Mail inhalt mit vba in Excel einfügen
von: fcs
Geschrieben am: 30.05.2015 10:10:36
Hallo Simon,
mit dem Betreff einer Outlook-Mail kann das eigentlich nichts zu tun haben.
Das Makro funktioniert so, dass du im Outlook-Mailordner die Mails selektierst, deren Daten du nach Excel in die Datei übertragen möchtest. Dann das Makro starten.
Wenn du nicht nur Daten aus Zeilen übertragen willst, die die gesuchten Texte enthalten,sondern auch anderen Bodytext, dann musst du dasMakro etwa wie folgt anpassen.
Ich hab die Fehlerbehandlung auch modifiziert, so dass gezielte Aktionen erfolgen und nicht einfach weitergemacht wird.
Gruß
Franz

'Makro unter Outlook 2010 -
'Im Outlook-VBA-Editor muss unter Extras--Verweise der Verweis auf
    'Microsoft Excel X.Y.Object Library
'gesetzt werden!!!!
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
   Dim sBodyZeilen As String, bolGelesen As Boolean
   
   Const strPath As String = "\\HE111168e004\a11949697$\Home\System\Desktop\Mappe.xlsx"
'   Const strPath As String = "C:\Users\Public\Test\MappeOL_Vorlage.xlsx"
   
   On Error GoTo Fehler
   
   If Application.ActiveExplorer.Selection.Count = 0 Then
       MsgBox "No Items selected!", vbCritical, "Error"
       Exit Sub
   End If
   
   Set xlApp = GetObject(, "Excel.Application")
   xlApp.StatusBar = "Please wait while Excel source is opened ... "
  
   'Open the workbook to input the data
   Set xlWB = xlApp.Workbooks.Open(strPath)
   Set xlSheet = xlWB.Sheets("Tabelle1")
   xlApp.ScreenUpdating = False
    'Find the last used line in column B of the worksheet
    rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(xlUp).Row
   'Process each selected record
   For Each olItem In Application.ActiveExplorer.Selection
       sText = olItem.Body
       sText = VBA.Replace(sText, Chr(10), "") 'Zeilenschaltung durch Leerstring ersetzen
       sText = VBA.Replace(sText, Chr(160), " ") 'Zeichen 160 (was auch immer das ist) _
                durch Leerzeichen ersetzen
       vText = Split(sText, Chr(13)) 'Bodytext am Absatzzeichen splitten
       rCount = rCount + 1
   
       'Check each line of text in the message body
       For i = UBound(vText) To 0 Step -1
           If Trim(vText(i)) <> "" Then
                bolGelesen = False
                
                If InStr(1, vText(i), "Source:") > 0 Then
                   vItem = Split(vText(i), Chr(58)) 'Chr(58) = ":"
                   If UBound(vItem) > 0 Then _
                        xlSheet.Range("A" & rCount) = Trim(vItem(1)): bolGelesen = True
                   
                End If
                
                If InStr(1, vText(i), "Kundennummer") > 0 Then
                   vItem = Split(vText(i), Chr(58))
                   If UBound(vItem) > 0 Then
                        xlSheet.Range("B" & rCount) = Trim(vItem(1))
                        myTime = olItem.ReceivedTime
                        xlSheet.Range("A" & rCount) = myTime
                        bolGelesen = True
                   End If
                End If
                
                If InStr(1, vText(i), "Produkt") > 0 Then
                   vItem = Split(vText(i), Chr(58))
                   If UBound(vItem) > 0 Then _
                        xlSheet.Range("C" & rCount) = Trim(vItem(1)): bolGelesen = True
                End If
                
                If InStr(1, vText(i), "Widerrufsfrist") > 0 Then
                   vItem = Split(vText(i), Chr(58))
                   If UBound(vItem) > 0 Then _
                        xlSheet.Range("D" & rCount) = Trim(vItem(1)): bolGelesen = True
                End If
                
                If InStr(1, vText(i), "Termin") > 0 Then
                   vItem = Split(vText(i), Chr(58))
                   If UBound(vItem) > 0 Then _
                        xlSheet.Range("E" & rCount) = Trim(vItem(1)): bolGelesen = True
                End If
                
                If bolGelesen = False Then
                    'Bodytext in Variable sammeln, wenn in den Zeilen oberhalb der Inhalt nicht  _
_
                            ausgewertet wurde
                    sBodyZeilen = vText(i) & IIf(sBodyZeilen = "", "", Chr(10)) & sBodyZeilen
                End If
          End If
       Next i
       If sBodyZeilen <> "" Then
            'restlichen Bodytext in Spalte F eintragen
            xlSheet.Range("A" & rCount) = olItem.ReceivedTime
            xlSheet.Range("F" & rCount) = sBodyZeilen
       End If
       xlWB.Save
   Next olItem
   
   xlWB.Close SaveChanges:=True
   xlApp.ScreenUpdating = True
   xlApp.StatusBar = False
   
   If bXStarted Then
       xlApp.Quit
   End If
   
Fehler:
   With Err
        Select Case .Number
            Case 0 'alles OK
            Case 429 'Excel-Anwendung ist nicht gestartet
                Set xlApp = CreateObject("Excel.Application")
                bXStarted = True
                xlApp.Visible = True  'kann wenn alles funktioniert deaktiviert werden
                Resume Next
            Case Else
                MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
                    vbOKOnly, "Outlook-Makro - copytoexcel"
                
        End Select
   End With
   Set xlApp = Nothing
   Set xlWB = Nothing
   Set xlSheet = Nothing
   Set olItem = Nothing
End Sub


Bild

Betrifft: AW: E-Mail inhalt mit vba in Excel einfügen
von: fcs
Geschrieben am: 28.05.2015 14:06:21
Hallo Simon,
das Makro scheint ja ein Outlook-Makro zu sein.
Im Outlook-VBA-Editor musst du unter Extras-Verweise den Verweis auf die "Mirosoft Excel X.Y Object Library" aktivieren (Häkchen setzen).
Gruß
Franz

 Bild

Beiträge aus den Excel-Beispielen zum Thema "E-Mail inhalt mit vba in Excel einfügen"