Laufzeitfehler beim auslesen von mails aus Outlook in Excel

  • Outlook

Es gibt 1 Antwort in diesem Thema. Der letzte Beitrag () ist von mumpel.

    Laufzeitfehler beim auslesen von mails aus Outlook in Excel

    Hallo ,

    Ich brauche eure Hilfe . Ich versuche E-Mails aus einem bestimmten Ordner zu lesen und in einer Excel Mappe zu übertragen . Alle Mails enthalten dieselbe Info und ich bräuchte quasi die angezeigt in einer bestimmte Reihenfolge , spaltenweise in Excel. Ich bin neu was so was angeht. Ich habe es irgendwie hingekriegt dass ich die erste Mail gelesen bekomme aber ich möchte dass es mir alles angezeigt werden und dass es aus einem bestimmten Folder "gelesen" werden. Dazu kriege ich eine Laufzeitfehler da wo die Zeile mit Range beginnt.
    Das Macro startet in Outlook. Ich würde mich echt freuen wenn ihr mir helfen könntet und Entschuldigung für eventuellen Rechtschreibung Fehler . Ich habe nicht Deutsch als Muttersprache.
    Danke im Voraus!
    Die Tabelle soll genau diese Überschriften enthalten :

    Datum/Titel der Veranstaltung:
    Firma:
    Straße:
    PLZ, Ort:
    Vorname:
    Name:
    Position:
    E-Mail:
    Telefon:
    Nachricht:
    Ich habe die allgemeinen Teilnahmebedingungen gelesen und
    akzeptiere diese.: Ja/Nein
    Ich möchte zum Newsletter angemeldet werden. Eine
    Abbestellung ist jederzeit möglich.: Ja/Nein

    Visual Basic-Quellcode

    1. Option Explicit
    2. Public Sub AnmeldedatenEintragen()
    3. Dim xlApp As Object
    4. Dim xlRange As Long
    5. Dim xlBook As Excel.Workbook
    6. Dim xlSheet As Excel.Worksheet
    7. Dim vntTempArray As Variant
    8. Dim obj As Object
    9. Dim folder As Outlook.MAPIFolder
    10. Dim folders As Outlook.folders
    11. Dim MailboxName
    12. Dim Pst_Folder_name
    13. Dim mIt As Outlook.MailItem
    14. Dim I As Integer
    15. Dim AnzEintraege As Integer
    16. MailboxName = " "
    17. Pst_Folder_name = "Posteingang"
    18. Set folder = Outlook.Session.folders(MailboxName).folders(Pst_Folder_name)
    19. AnzEintraege = folder.Items.Count
    20. If folder = "" Then
    21. MsgBox "Keine Mails"
    22. End If
    23. Select Case True
    24. Case TypeOf Application.ActiveWindow Is Outlook.Inspector
    25. Set obj = Application.ActiveInspector.CurrentItem
    26. Case Else
    27. With Application.ActiveExplorer.Selection
    28. If .Count Then Set obj = .Item(1)
    29. End With
    30. If obj Is Nothing Then Exit Sub
    31. End Select
    32. vntTempArray = Split(obj.Body, vbCrLf)
    33. Set xlApp = New Excel.Application
    34. With xlApp
    35. .Visible = True
    36. .Workbooks.Open FileName:="T:" & "\Mappe1.xlsx"
    37. Set xlBook = xlApp.Workbooks("Mappe1.xlsx")
    38. Set xlSheet = xlBook.Sheets("Tabelle1")
    39. AnzEintraege = folder.Items.Count
    40. With xlBook
    41. With xlSheet
    42. While I < AnzEintraege
    43. xlRange = _
    44. .Range("A" & .Rows.Count).End(xlUp).Row + 1
    45. .Range("B" & xlRange) = Replace(vntTempArray(2), "Datum: ", "")
    46. .Range("C" & xlRange) = Replace(vntTempArray(3), "Veranstaltung: ", "")
    47. .Range("D" & xlRange) = Replace(vntTempArray(4), "Unternehmen: ", "")
    48. .Range("E" & xlRange) = Replace(vntTempArray(5), "Vorname: ", "")
    49. .Range("F" & xlRange) = Replace(vntTempArray(6), "Nachname: ", "")
    50. .Range("H" & xlRange) = Replace(vntTempArray(7), "Position: ", "")
    51. .Range("I" & xlRange) = Replace(vntTempArray(8), "E-Mail: ", "")
    52. .Range("J" & xlRange) = Replace(vntTempArray(9), "Anzahl Teilnehmer: ", "")
    53. .Range("K" & xlRange) = Replace(vntTempArray(10), "Telefon: ", "")
    54. .Range("L" & xlRange) = Replace(vntTempArray(11), "Nachricht: ", "")
    55. .Range("M" & xlRange) = Replace(vntTempArray(12), "Ich habe die Teilnahmebedingungen gelesen und akzeptiert: ", "")
    56. .Range("N" & xlRange) = Replace(vntTempArray(13), "Ich möchte zum Newsletter angemeldet werden. Eine Abbestellung ist jederzeit möglich.: ", "")
    57. Wend
    58. End With
    59. 'mIt.UnRead = False
    60. 'Stmp = ""
    61. 'For i = 1 To mIt.Parent.folders.Count()
    62. ' If mIt.Parent.folders(i).Name = "Erledigt" Then
    63. 'Stmp = "OK"
    64. 'Exit For
    65. 'End If
    66. 'Next i
    67. 'If Len(Stmp) = 0 Then mIt.Parent.folders.Add "Erledigt"
    68. 'mIt.Move mIt.Parent.folders("Erledigt")
    69. 'Set mIt = Nothing
    70. .Save
    71. .Close
    72. End With
    73. .Quit
    74. End With
    75. ende:
    76. xlRange = 0
    77. Set xlSheet = Nothing
    78. Set xlBook = Nothing
    79. Set xlApp = Nothing
    80. End Sub
    Hallo!

    Wichtig: Bitte nutze als Variablennamen keine reserviertenNamen. "Folders" z.B. ist ein reservierte Name den man nicht als Variablenname nutzen sollte.

    Visual Basic-Quellcode

    1. Option Explicit
    2. Public Sub AnmeldedatenEintragen()
    3. Dim xlRange As Long
    4. Dim lngStart As Long
    5. Dim xlApp As New Excel.Application
    6. Dim xlBook As Excel.Workbook
    7. Dim xlSheet As Excel.Worksheet
    8. Dim obj As Object
    9. Dim vntTempArray As Variant
    10. Dim strMailboxName As String
    11. Dim strPstFolderName As String
    12. Dim strFolderName As Outlook.MAPIFolder
    13. strMailboxName = "René Holtz"
    14. strPstFolderName = "Posteingang"
    15. Set strFolderName = Outlook.Session.folders(strMailboxName).folders(strPstFolderName).folders("Support").folders("Erledigt")
    16. If strFolderName.Items.Count = 0 Then
    17. MsgBox "Keine Mails vorhanden.", 64, "Hinweis"
    18. Exit Sub
    19. End If
    20. Set xlApp = New Excel.Application
    21. With xlApp
    22. .Visible = True
    23. .Workbooks.Open FileName:="T:" & "\Mappe1.xlsx"
    24. Set xlBook = xlApp.Workbooks("Mappe1.xlsx")
    25. Set xlSheet = xlBook.Sheets("Tabelle1")
    26. With xlBook
    27. With xlSheet
    28. For lngStart = strFolderName.Items.Count To 1 Step -1
    29. vntTempArray = Split(strFolderName.Items(lngStart).Body, vbCrLf)
    30. xlRange = _
    31. .Range("A" & .Rows.Count).End(xlUp).Row + 1
    32. .Range("B" & xlRange) = Replace(vntTempArray(2), "Datum: ", "")
    33. .Range("C" & xlRange) = Replace(vntTempArray(3), "Veranstaltung: ", "")
    34. .Range("D" & xlRange) = Replace(vntTempArray(4), "Unternehmen: ", "")
    35. .Range("E" & xlRange) = Replace(vntTempArray(5), "Vorname: ", "")
    36. .Range("F" & xlRange) = Replace(vntTempArray(6), "Nachname: ", "")
    37. .Range("H" & xlRange) = Replace(vntTempArray(7), "Position: ", "")
    38. .Range("I" & xlRange) = Replace(vntTempArray(8), "E-Mail: ", "")
    39. .Range("J" & xlRange) = Replace(vntTempArray(9), "Anzahl Teilnehmer: ", "")
    40. .Range("K" & xlRange) = Replace(vntTempArray(10), "Telefon: ", "")
    41. .Range("L" & xlRange) = Replace(vntTempArray(11), "Nachricht: ", "")
    42. .Range("M" & xlRange) = Replace(vntTempArray(12), _
    43. "Ich habe die Teilnahmebedingungen gelesen und akzeptiert: ", "")
    44. .Range("N" & xlRange) = Replace(vntTempArray(13), _
    45. "Ich möchte zum Newsletter angemeldet werden. Eine Abbestellung ist jederzeit möglich.: ", "")
    46. Next lngStart
    47. End With
    48. .Save
    49. .Close
    50. End With
    51. .Quit
    52. End With
    53. ende:
    54. Set xlSheet = Nothing
    55. Set xlBook = Nothing
    56. Set xlApp = Nothing
    57. End Sub


    "MailboxName" darf übrigens nicht leer sein. Denn das ist der Name des Outlook-Ordners (PST-Datei ohne Dateiendung).

    Gruß, René

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „mumpel“ ()