AW: Outlook-Maileintrag auslesen
14.03.2005 13:55:57
Peter
Hallo Frank
Noch etwas, eine Delux-Ausführung wäre folgende: alle Mails kommen vom gleichen Absender (Provider der Anmeldeformulares). Wenn ich mit einer Schlaufe alle Mails suchen könnte, die von diesem Absender sind, das Mail auslesen, und die Absenderadresse durch die effektive Mail-Adresse ersetzen, welche im Mail mitgeliefert wird. -
Dies hätte den Vorteil, dass keine Anmeldung "untergeht" und ich könnte nach der Importierung der Adresse ins Excelsheet, gleich mit Mail-Antworten mit dem Interessent in Verbindung treten. Mit dem folgenden Mail, das ich in diesem Forum gefunden habe, kann man alle Mails ins excel exportieren
Doch ist es für mich etwas komplex um diese Anpassung zu machen - viellecht schaffst du es - vielen Dank aus der Schweiz! Peter
Sub GrapIext()
Dim objOutlook As Object
Dim objnSpace As Object
Dim objFolder As Object
Dim objMsg As Object
Dim intCounter As Integer, intCount As Integer, iRow As Integer
Dim sText As String
Application.ScreenUpdating = False
'Set objOutlook = CreateObject("Outlook.Application")
Set objOutlook = CreateObject("Lotus-Notes.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
Set objFolder = objnSpace.folders("Persönliche Ordner").folders("Posteingang")
intCount = objFolder.Items.Count
If intCount > 0 Then
For intCounter = 1 To intCount
Set objMsg = objFolder.Items(intCounter)
MsgBox intCounter & " von " & intCount
Worksheets.Add after:=Worksheets(Worksheets.Count)
objMsg.SaveAs ThisWorkbook.Path & "\temp.txt", olTXT
Close
iRow = 0
Open ThisWorkbook.Path & "\temp.txt" For Input As #1
Do Until EOF(1)
iRow = iRow + 1
Line Input #1, sTxt
Cells(iRow, 1).Value = "'" & sTxt
Loop
Close
Next intCounter
Kill ThisWorkbook.Path & "\'temp.txt"
End If
Set objnSpace = Nothing
Set objFolder = Nothing
Set objMsg = Nothing
Set objOutlook = Nothing
End Sub