Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Outlook und Excel

Forumthread: Outlook und Excel

Outlook und Excel
07.07.2002 23:15:41
FrankyB
Hallo Leute,
unten aufgeführt habe ich ein Makro von Hans welches ich gerne etwas verändern möchte, habe aber keine ausreichende Kenntnis um dieses zu tun. Ich hoffe auf euch.

In dem Makro werden alle eMails aus dem Posteingangsordner – in Excel exportiert. Pro eMail wird ein neues Tabellenblatt eingefügt. Also bei 20 eMails – sind in der Arbeitsmappe somit 20 Tabellenblätter angelegt worden.

Nun soll das Makro aber alle eMails in nur ein Tabellenblatt einfügen und für die einzelne eMail je eine Spalte aus der Tabelle belegen. Also Mail1 in Spalte A und Mail2 in Spalte B und so weiter.

Kann mir hier einer helfen???
Ich bedanke mich im voraus
Gruß Frank


Sub GrapText()
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 sTxt As String
Application.ScreenUpdating = False
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
Set objFolder = objnSpace.folders("Persönlicher Ordner").folders("Posteingang")
intCount = objFolder.Items.Count
If intCount > 0 Then
For intCounter = 1 To intCount
Set objMsg = objFolder.Items(intCounter)
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

Anzeige

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

Betreff
Datum
Anwender
Anzeige
Re: Outlook und Excel
07.07.2002 23:31:22
thomas Eckel
Hallo Frank,
hier ein neues Code-Stück

For intCounter = 1 To intCount
Set objMsg = objFolder.Items(intCounter)
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, intCounter).Value = "'" & sTxt
Loop
Close
Next intCounter

Jetzt solte die Funktionalität gegeben sein.
Gruß
Thomas

Anzeige
Re: Danke, Funktioniert
07.07.2002 23:52:58
FrankyB
Hi Thomas,
Funktioniert
Danke noch mal
Gruß Frank
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige