AW: Email-Infos aus Outlook ins Excel einlesen
23.11.2012 11:54:19
Marc
Moin!
Hast du ein Glück!!!
Sub Outlook_InBox_Check()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim numMails As Long, i As Long, Email As Long
Set OLF = CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6)
numMails = OLF.Items.Count
Sheets(1).[A:E].ClearContents
zeil = 2
'Sheets(1).Cells(1, 1) = "index"
Sheets(1).Cells(1, 1) = "Absender"
Sheets(1).Cells(1, 2) = "Betreff"
Sheets(1).Cells(1, 3) = "erhalten (Datum)"
Sheets(1).Cells(1, 4) = "erhalten (Zeit)"
Sheets(1).Cells(1, 5) = "NETTO Bearbeitungszeit"
'Sheets(1).Cells(1, 5) = "letzte Bearbeitung"
'Sheets(1).Cells(1, 6) = "BRUTTO Bearbeitungszeit"
'Sheets(1).Cells(1, sp + 6) = kenn
'Tage vorm WE
'Sheets(1).Cells(1, 7) = "Bearb ins WE"
'Sheets(1).Cells(1, 8) = "Bearb aus WE"
'Sheets(1).Cells(1, 9) = "Tage aus volle WE"
'Application.ScreenUpdating = False
While i Bearb And kenn = 1 Then
zeitraum = Bearb - eing
Anfangs_WE = IIf(Weekday(eing, 2) >= 5, Abs(-7 + Weekday(eing, 2)), 0)
Ende_WE = IIf(Weekday(Bearb, 2) 3, 2, 0)
WE_s = IIf(zeitraum > 7, Fix(zeitraum / 7), 0)
Sheets(1).Cells(zeil, sp + 1) = .SenderName
Sheets(1).Cells(zeil, sp + 2) = .Subject
Sheets(1).Cells(zeil, sp + 3) = Format(eing, "dd.mm.yyyy")
Sheets(1).Cells(zeil, sp + 4) = Format(eing, "hh:mm")
Sheets(1).Cells(zeil, sp + 5) = Bearb - eing - IIf(Bearb - eing > 2, _
Anfangs_WE - Ende_WE, 0) - WorksheetFunction.Max((WE_s * 2) - Anfangs_WE - Ende_WE, 0)
'Sheets(1).Cells(zeil, sp + 4) = Format(Bearb, "ddd dd.mm.yy - hh:mm")
'Sheets(1).Cells(zeil, sp + 5) = zeitraum
'Sheets(1).Cells(zeil, sp + 6) = kenn
'Sheets(1).Cells(zeil, sp) = i
'Tage vorm WE
'Sheets(1).Cells(zeil, sp + 6) = Anfangs_WE
'Sheets(1).Cells(zeil, sp + 7) = Ende_WE
'Sheets(1).Cells(zeil, sp + 8) = WorksheetFunction.Max((WE_s * 2) - _
Anfangs_WE - Ende_WE, 0)
zeil = zeil + 1
End If
End If
End With
Wend
'########################################################################################### _
Dim ChosenFolder As Object
Auswahl:
Application.ScreenUpdating = True
Mehr_lesen = MsgBox("Möchtest Du einen weiteren Ordner durchsuchen?", vbYesNo + vbQuestion, _
"Weiteren Ordner wählen")
Application.ScreenUpdating = False
If Mehr_lesen = vbYes Then
Set ChosenFolder = CreateObject("Outlook.Application").GetNamespace("MAPI").PickFolder
If ChosenFolder Is Nothing Then MsgBox ("Du hast keinen weiteren Ordner ausgewählt!"): _
GoTo Ende:
numMails = ChosenFolder.Items.Count
i = 0
While i Bearb And kenn = 1 Then 'nur bearbeitete und als erledigt _
gekennzeichnet.
zeitraum = Bearb - eing
Anfangs_WE = IIf(Weekday(eing, 2) >= 5, Abs(-7 + Weekday(eing, 2)), 0)
Ende_WE = IIf(Weekday(Bearb, 2) 4, 2, 0)
WE_s = IIf(zeitraum > 7, Fix(zeitraum / 7), 0)
If zeitraum > 2 Then
zeitraum = zeitraum - Anfangs_WE
Else
zeitraum = zeitraum - Ende_WE - WorksheetFunction.Max((WE_s * 2) - _
Anfangs_WE - Ende_WE, 0)
End If
Sheets(1).Cells(zeil, sp + 1) = .SenderName
Sheets(1).Cells(zeil, sp + 2) = .Subject
Sheets(1).Cells(zeil, sp + 3) = Format(eing, "dd.mm.yyyy")
Sheets(1).Cells(zeil, sp + 4) = Format(eing, "hh:mm")
Sheets(1).Cells(zeil, sp + 5) = zeitraum
If Sheets(1).Cells(zeil, sp + 5)
Gruß, MCO