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
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
- Option Explicit
- Public Sub AnmeldedatenEintragen()
- Dim xlApp As Object
- Dim xlRange As Long
- Dim xlBook As Excel.Workbook
- Dim xlSheet As Excel.Worksheet
- Dim vntTempArray As Variant
- Dim obj As Object
- Dim folder As Outlook.MAPIFolder
- Dim folders As Outlook.folders
- Dim MailboxName
- Dim Pst_Folder_name
- Dim mIt As Outlook.MailItem
- Dim I As Integer
- Dim AnzEintraege As Integer
- MailboxName = " "
- Pst_Folder_name = "Posteingang"
- Set folder = Outlook.Session.folders(MailboxName).folders(Pst_Folder_name)
- AnzEintraege = folder.Items.Count
- If folder = "" Then
- MsgBox "Keine Mails"
- End If
- Select Case True
- Case TypeOf Application.ActiveWindow Is Outlook.Inspector
- Set obj = Application.ActiveInspector.CurrentItem
- Case Else
- With Application.ActiveExplorer.Selection
- If .Count Then Set obj = .Item(1)
- End With
- If obj Is Nothing Then Exit Sub
- End Select
- vntTempArray = Split(obj.Body, vbCrLf)
- Set xlApp = New Excel.Application
- With xlApp
- .Visible = True
- .Workbooks.Open FileName:="T:" & "\Mappe1.xlsx"
- Set xlBook = xlApp.Workbooks("Mappe1.xlsx")
- Set xlSheet = xlBook.Sheets("Tabelle1")
- AnzEintraege = folder.Items.Count
- With xlBook
- With xlSheet
- While I < AnzEintraege
- xlRange = _
- .Range("A" & .Rows.Count).End(xlUp).Row + 1
- .Range("B" & xlRange) = Replace(vntTempArray(2), "Datum: ", "")
- .Range("C" & xlRange) = Replace(vntTempArray(3), "Veranstaltung: ", "")
- .Range("D" & xlRange) = Replace(vntTempArray(4), "Unternehmen: ", "")
- .Range("E" & xlRange) = Replace(vntTempArray(5), "Vorname: ", "")
- .Range("F" & xlRange) = Replace(vntTempArray(6), "Nachname: ", "")
- .Range("H" & xlRange) = Replace(vntTempArray(7), "Position: ", "")
- .Range("I" & xlRange) = Replace(vntTempArray(8), "E-Mail: ", "")
- .Range("J" & xlRange) = Replace(vntTempArray(9), "Anzahl Teilnehmer: ", "")
- .Range("K" & xlRange) = Replace(vntTempArray(10), "Telefon: ", "")
- .Range("L" & xlRange) = Replace(vntTempArray(11), "Nachricht: ", "")
- .Range("M" & xlRange) = Replace(vntTempArray(12), "Ich habe die Teilnahmebedingungen gelesen und akzeptiert: ", "")
- .Range("N" & xlRange) = Replace(vntTempArray(13), "Ich möchte zum Newsletter angemeldet werden. Eine Abbestellung ist jederzeit möglich.: ", "")
- Wend
- End With
- 'mIt.UnRead = False
- 'Stmp = ""
- 'For i = 1 To mIt.Parent.folders.Count()
- ' If mIt.Parent.folders(i).Name = "Erledigt" Then
- 'Stmp = "OK"
- 'Exit For
- 'End If
- 'Next i
- 'If Len(Stmp) = 0 Then mIt.Parent.folders.Add "Erledigt"
- 'mIt.Move mIt.Parent.folders("Erledigt")
- 'Set mIt = Nothing
- .Save
- .Close
- End With
- .Quit
- End With
- ende:
- xlRange = 0
- Set xlSheet = Nothing
- Set xlBook = Nothing
- Set xlApp = Nothing
- End Sub