micha
Erfahrenes Mitglied
Guten Morgen,
Auf Grund eines neuen Jobs erhalte ich jede Menge eMails und würde daher nun gerne aufzeigen , wie sich die Anzahl Mails im Verlauf der letzten Wochen entwickelt haben. Da ich VBA nur als bestenfalls Kauderwelsch kann, wollte ich fragen, ob jemand mir helfen kann angefügten VBA durch eine Schleife (startdatum, zieldatum) zu ergänzen und den Output statt in einer Textbox in eine CSV zu speichern.
Ich habe einen Code Schnipsel gefunden, der letztlich das macht, was ich will - aber nur für einen Tag, statt für einen Zeitraum und nur als Message, statt als CSV. Ich schätze der Aufwand für einen Erfahrenen das umzubasteln sollte 5-10 Minuten sein![Smile :) :)](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f642.png)
Vielen Dank,
Micha
Auf Grund eines neuen Jobs erhalte ich jede Menge eMails und würde daher nun gerne aufzeigen , wie sich die Anzahl Mails im Verlauf der letzten Wochen entwickelt haben. Da ich VBA nur als bestenfalls Kauderwelsch kann, wollte ich fragen, ob jemand mir helfen kann angefügten VBA durch eine Schleife (startdatum, zieldatum) zu ergänzen und den Output statt in einer Textbox in eine CSV zu speichern.
Ich habe einen Code Schnipsel gefunden, der letztlich das macht, was ich will - aber nur für einen Tag, statt für einen Zeitraum und nur als Message, statt als CSV. Ich schätze der Aufwand für einen Erfahrenen das umzubasteln sollte 5-10 Minuten sein
![Smile :) :)](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f642.png)
Visual Basic:
Sub Countemailsperday()
Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder
Dim EmailCount As Integer
Dim oDate As String
oDate = InputBox("Type the date for count (format YYYY-m-d")
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
On Error Resume Next
Set objFolder = Application.ActiveExplorer.CurrentFolder
If Err.Number <> 0 Then
Err.Clear
MsgBox "No such folder."
Exit Sub
End If
EmailCount = objFolder.Items.Count
MsgBox "Number of emails in the folder: " & EmailCount, , "email count"
Dim ssitem As MailItem
Dim dateStr As String
Dim myItems As Outlook.Items
Dim dict As Object
Dim msg As String
Set dict = CreateObject("Scripting.Dictionary")
Set myItems = objFolder.Items
myItems.SetColumns ("ReceivedTime")
' Determine date of each message:
For Each myItem In myItems
dateStr = GetDate(myItem.ReceivedTime)
If dateStr = oDate Then
If Not dict.Exists(dateStr) Then
dict(dateStr) = 0
End If
dict(dateStr) = CLng(dict(dateStr)) + 1
End If
Next myItem
' Output counts per day:
msg = ""
For Each o In dict.Keys
msg = msg & o & ": " & dict(o) & " items" & vbCrLf
Next
MsgBox msg
Set objFolder = Nothing
Set objnSpace = Nothing
Set objOutlook = Nothing
End Sub
Function GetDate(dt As Date) As String
GetDate = Year(dt) & "-" & Month(dt) & "-" & Day(dt)
End Function
Vielen Dank,
Micha