email Import: Body OK, Attachment?
24.09.2005 08:57:35
der_schmid
ich habe hier das Problem das ich wunderbar aus Outlook alle im Ordner Eingang befindlichen Emails nach Excel importieren kann, möchte aber auch die Attachments (_Name) in meine Tabelle eintragen.
Wer kann mit da behilflich sein? Gibt es eine Möglichkeit Attachments zentral zu speichern (z.B. C:\trallala\)
Den Code des Imports erkennt Ihr nachfolgend:
Private Sub CommandButtonX_Click()
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>direkt aus dem Posteingang
'On Error Resume Next
Dim OLF As Outlook.MAPIFolder, CurrUser As String
Dim EmailItemCount As Integer, i As Integer, EmailCount As Integer
Application.ScreenUpdating = False
Sheets("e-mails_E").Activate 'Eingang
Cells(1, 1).Formula = "Betreff"
Cells(1, 2).Formula = "Erhalten am"
Cells(1, 3).Formula = "Attachments"
Cells(1, 4).Formula = "Inhalt"
Cells(1, 5).Formula = "Empfangen von"
Cells(1, 6).Formula = "attachment"
With Range("A1:E1").Font
.Bold = True
.Size = 10
.ColorIndex = 3
End With
Application.Calculation = xlCalculationManual
Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
EmailItemCount = OLF.Items.Count
i = 0: EmailCount = 0
' lese e-mail information
While i < EmailItemCount
i = i + 1
If i Mod 50 = 0 Then Application.StatusBar = "Reading e-mail messages " & Format(i / EmailItemCount, "0%") & "..."
With OLF.Items(i)
EmailCount = EmailCount + 1
Cells(EmailCount + 1, 1).Formula = .Subject
Cells(EmailCount + 1, 2).Formula = Format(.ReceivedTime, "dd.mm.yyyy hh:mm")
Cells(EmailCount + 1, 3).Formula = .Attachments.Count
Cells(EmailCount + 1, 4).Formula = .body
Cells(EmailCount + 1, 5).Formula = .SenderName
Cells(EmailCount + 1, 6).Formula = ' da hätte ich gerne das Attachment
End With
Wend
Application.Calculation = xlCalculationAutomatic
Set OLF = Nothing
Range("A2").Select
ActiveWindow.FreezePanes = True
ActiveWorkbook.Saved = True
Application.StatusBar = False
End Sub
Anzeige