Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1208to1212
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

@ Sepp: Ordner auslesen

@ Sepp: Ordner auslesen
Claudia
Hallo Sepp,
ich bräuchte noch einmal Deine Hilfe!
Ich benötige ein Makro, was einen Windowsordner ausliest, in dem sich Mails befinden. Die Besonderheit ist, dass neben den Namen, dem letzten Änderungsdatum der Datai auch das Datum der eigentlichen Mail aufgelistet werden soll? Wäre insbesondere das letzte möglich?
Spalte A Name mit Hyperlink auf die Dazei
Spalte B letztes Änderungsdatum
Spalte C Maildatum
Wäre sowas machbar und würdest Du Dir das mal anschauen?
Vielen lieben Dank!
Liebe Grüße
Claudia
AW: @ Sepp: Ordner auslesen
24.04.2011 20:53:23
Josef

Hallo Claudia,
um welche Art von Maildatei handelt es sich?
Kann st du so eine Datei gezipt hochladen?

« Gruß Sepp »

AW: @ Sepp: Ordner auslesen
24.04.2011 21:03:09
Claudia
Hallo Sepp,
der Dateityp ist Outlook-Element (.msg). Meinst Du sowas?
Wie meinst Du das mit der gezipten Datei? Eine Excel-DAtei habe ich noch gar nicht.
Anzeige
AW: @ Sepp: Ordner auslesen
24.04.2011 21:44:30
Josef

Hallo Claudia,
es gibt ja auch andere mailprogramme ausser OutLook.
Teste mal.

Die Datei https://www.herber.de/bbs/user/74528.xls wurde aus Datenschutzgründen gelöscht



« Gruß Sepp »

Einfach super. Du hast mir mal wieder
24.04.2011 21:56:50
Claudia
geholfen. :-)
Vielen, vielen Dank!
Anzeige
@ Sepp: Noch eine Frage
25.04.2011 13:59:08
Claudia
Hallo Sepp,
kannst Du auch ermitteln, wer Empäfnger und Sender der Mail ist? Wenn ja, könntest Du dies noch in Spalte D und E auflisten?
Ich vermute aber, dass das nicht geht - aber fragen kann ich ja mal.
VIelen Dank!
Liebe Grüße
Claudia
AW: @ Sepp: Noch eine Frage
25.04.2011 14:16:27
Josef

Hallo Claudi,
klar geht das.
https://www.herber.de/bbs/user/74535.xls

« Gruß Sepp »

Anzeige
Merci :-)
25.04.2011 15:53:51
Claudia
Ich hätte auch eine Frage an Sepp
25.04.2011 16:47:59
Martin
Hallo Sepp,
dieses Problem hat auch mich länger beschäftigt und ich bin von dieser Lösung begeistert! Nun meine Frage: ist es möglich, dass die ausgelesenen Absender Adressen in der Excel Liste als Hyperlinks erscheinen?
Danke und Gruß
Martin
AW: Ich hätte auch eine Frage an Sepp
25.04.2011 17:12:02
Josef

Hallo Martin,
ersetze den Code durch folgenden.
Sub readMailFiles()
  Dim strPath As String, strFile As String
  Dim lngRow As Long
  Dim objOL As Object, objMail As Object, objFSO As Object
  With Sheets("Tabelle1")
    strPath = .Range("A2").Text
    If Dir(strPath, vbDirectory) <> "" Then
      strPath = IIf(Right(strPath, 1) = "\", strPath, strPath & "\")
      
      strFile = Dir(strPath & "*.msg", vbNormal)
      
      lngRow = 4
      
      .Range("A4:E" & .Rows.Count).ClearContents
      
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      Set objOL = CreateObject("Outlook.Application")
      Do While strFile <> ""
        Set objMail = objOL.CreateItemFromTemplate(strPath & strFile)
        .Hyperlinks.Add anchor:=.Cells(lngRow, 1), _
          Address:=strPath & strFile, TextToDisplay:=strFile
        .Cells(lngRow, 2) = objFSO.getfile(strPath & strFile).DateLastModified
        'ginge zwar auch, liefert aber oft unsinnige Daten!
        '.Cells(lngRow, 2) = objMail.LastModificationTime
        .Cells(lngRow, 3) = objMail.ReceivedTime
        .Hyperlinks.Add anchor:=.Cells(lngRow, 4), _
          Address:="MailTo:" & objMail.SenderEmailAddress, _
          TextToDisplay:=objMail.SenderEmailAddress
        .Hyperlinks.Add anchor:=.Cells(lngRow, 5), _
          Address:="MailTo:" & objMail.Recipients(1).Address, _
          TextToDisplay:=objMail.Recipients(1).Address
        strFile = Dir
        lngRow = lngRow + 1
      Loop
    Else
      MsgBox "Ungültiges Verzeichnis!", vbExclamation, "Hinweis"
    End If
    .Range("A:E").Columns.AutoFit
  End With
  Set objOL = Nothing
  Set objMail = Nothing
End Sub



« Gruß Sepp »

Anzeige
Perfekt!
25.04.2011 17:18:56
Martin
Dankeschön!
Mails löschen
25.04.2011 19:42:57
Claudia
Hallo Sepp,
könnte man auf diesem Wege auch Mails löschen? Als beispielsweise ruf ich eine Mail auf und sage die kann weg. Und jetzt müsste ich eine Lösch-Funktion in der Excel-Datei haben. Beispielsweise in Spalte F trage ich ein "delete" ein und mit einem weiteren Button würden sowohl die Mails aus dem Ordner als auch aus der Datei verschwinden?
Ich hab schon ein sehr schlechtes Gewissen. :-(
Liebe Grüße
Claudia
AW: Mails löschen
25.04.2011 20:03:38
Josef

Hallo Claudia,
brauchst kein schlechtes Gewissen zu haben, ich helfe doch gerne :-))

Die Datei https://www.herber.de/bbs/user/74543.xls wurde aus Datenschutzgründen gelöscht



« Gruß Sepp »

Anzeige
Super! Habe mich für Lösung 1
25.04.2011 21:51:48
Claudia
der Übersicht halber entschieden, wobei Lösung 2 auch ihren Charme hat.
Vielen vielen Dank!
Anzeige
Kleiner Fehler?
26.04.2011 07:52:58
Claudia
Hallo Sepp,
bislang lief das Makro super. Nun habe ich einen ordner mit fast 1.200 Mails auslesen wollen und das will das Makro nicht. Es öffnet sich dann das Fenster "Ordner auswählen" und ausgewählt ist Posteingang.
Im Code hängt er dann an dieser Zeile:
Set objMail = objOL.CreateItemFromTemplate(strPath & strFile)
Kannst Du bitte mal schauen. Vielen Dank!
Liebe Grüße
Claudia
AW: Kleiner Fehler?
26.04.2011 21:07:06
Josef

Hallo Claudia,
"Kannst Du bitte mal schauen."
ja, aber wo?
Ich habe keine 1.200 msg-Dateien und schon gar nicht deine!
Wahrscheinlich verursacht eine fehlerhafte Datei dieses Verhalten.
Probier mal den folgenden Code.
Sub readMailFiles()
  Dim strPath As String, strFile As String
  Dim lngRow As Long, lngIndex As Long, lngC As Long
  Dim objOL As Object, objMail As Object, objFSO As Object
  Dim vntNotImported() As Variant
  With Sheets("Tabelle1")
    strPath = .Range("A2").Text
    If Dir(strPath, vbDirectory) <> "" Then
      strPath = IIf(Right(strPath, 1) = "\", strPath, strPath & "\")
      
      strFile = Dir(strPath & "*.msg", vbNormal)
      
      lngRow = 4
      
      .Range("A4:F" & .Rows.Count).ClearContents
      
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      Set objOL = CreateObject("Outlook.Application")
      Do While strFile <> ""
        On Error Resume Next
        Set objMail = objOL.CreateItemFromTemplate(strPath & strFile)
        .Hyperlinks.Add anchor:=.Cells(lngRow, 1), _
          Address:=strPath & strFile, TextToDisplay:=strFile
        .Cells(lngRow, 2) = objFSO.getfile(strPath & strFile).DateLastModified
        'ginge zwar auch, liefert aber oft unsinnige Daten!
        '.Cells(lngRow, 2) = objMail.LastModificationTime
        .Cells(lngRow, 3) = objMail.ReceivedTime
        .Hyperlinks.Add anchor:=.Cells(lngRow, 4), _
          Address:="MailTo:" & objMail.SenderEmailAddress, _
          TextToDisplay:=objMail.SenderEmailAddress
        .Hyperlinks.Add anchor:=.Cells(lngRow, 5), _
          Address:="MailTo:" & objMail.Recipients(1).Address, _
          TextToDisplay:=objMail.Recipients(1).Address
        Err.Clear
        On Error GoTo 0
        strFile = Dir
        lngRow = lngRow + 1
      Loop
    Else
      MsgBox "Ungültiges Verzeichnis!", vbExclamation, "Hinweis"
    End If
    .Range("A:E").Columns.AutoFit
  End With
  Set objOL = Nothing
  Set objMail = Nothing
End Sub



« Gruß Sepp »

Anzeige
Fehler behoben
27.04.2011 07:09:43
Claudia
Hallo Sepp,
sorry für diese Beschreibung. Aber es hat geholfen, der Fehler ist weg.
Vielen Dank, Du bist echt ein Genie und sehr sehr hilfsbereit.
Liebe Grüße
Claudia
AW: Ich hätte auch eine Frage an Sepp
26.04.2011 10:14:10
Mister
Hallo Sepp,
dieses Makro wird immer besser! Danke dafür. Kann man statt den Empfängernamen den angezeigten "Aliasnamen" auslesen?
Gruß
Martin
Martin: Du musst die Frage auch offen lassen,
26.04.2011 18:41:09
Claudia
darüber hinaus wäre es nett, wenn erst einmal mein Fehler geprüft werden kann. Da verliert man ja selbst die Übersicht.
So wie Sepp kenne, wird er Dir dann auch noch helfen. :-)
AW: Ich hätte auch eine Frage an Sepp
26.04.2011 21:09:22
Josef

Hallo Martin,
ja, kann man;-))
ersetze
.Recipients(1).Address
durch

.Recipients(1).Name


« Gruß Sepp »

Anzeige
AW: Ich hätte auch eine Frage an Sepp
26.04.2011 21:44:53
Tobias
Hallo Sepp,
wäre das auch beim Absender möglich? Das wäre echt cool.
Deine Lösung ist echt spitze!
Viele Grüße
Tobias
AW: Ich hätte auch eine Frage an Sepp
26.04.2011 21:52:59
Josef

Hallo Tobias,
da kann man aber auch mit "VBA bescheiden" mit ein bisschen nachdenken selber draufkommen.
statt

objMail.SenderEmailAddress
eben

objMail.SenderName


« Gruß Sepp »

Anzeige
AW: Ich hätte auch eine Frage an Sepp
26.04.2011 21:57:58
Tobias
hatte es mit objMail.SenderEmailName versucht, aber da war halt das Email noch drin.
Danke für Deinen Tipp. :-)

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige