Rem Koden anbringes under Ark - højreklik / vis programkode / Rem Reference sættes til Microsoft Outlook xx Object Library under Tools / References Dim sidsteRæk As Long Public Sub optælAntalMailPrDato() Dim antalMails As Integer sidsteRæk = ActiveCell.SpecialCells(xlLastCell).Row
antalMails = åbnOutlookMappe(afold) placerEfterDato antalMails, afold End Sub Private Function åbnOutlookMappe(afold) Dim mailApp, Namespace
Set mailApp = CreateObject("Outlook.Application") Set Namespace = mailApp.GetNamespace("MAPI") Set afold = Namespace.GetDefaultFolder(olFolderInbox)
åbnOutlookMappe = afold.Items.Count End Function Private Sub placerEfterDato(antalMails As Integer, afold) Dim mx As MailItem, modtagetDen As Date, dRæk As Long If antalMails > 0 Then
Application.ScreenUpdating = False For m = 1 To antalMails Set mx = afold.Items(m)
modtagetDen = Format(mx.ReceivedTime, "dd-mm-yy") Rem findes dato i kolonne A dRæk = findesDato("A2:A" & sidsteRæk, modtagetDen) If dRæk = 0 Then sidsteRæk = sidsteRæk + 1 Range("A" & sidsteRæk) = modtagetDen Range("B" & sidsteRæk) = 1 Else Range("B" & dRæk) = Range("B" & dRæk) + 1 End If Next m End If Application.ScreenUpdating = True
Columns.AutoFit End Sub Private Function findesDato(område, id) With ActiveWorkbook.Sheets("Ark1").Range(område) Set c = .Find(id, LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then findesDato = c.Row Else findesDato = 0 End If End With End Function
Koden skal indsættes i Excel og der skal herfra sættes en reference til Outlook - men det nemmeste vil være at jeg sende min Excefil til dig. Hvilken version af Excel anvender du?
Jeg har samme udfordring - og vil gerne have talt op på antal mails i en postkasse - men kan ikke få det til at virke. Når scriptet afvikles via F5 og makroen kommer der en meddelelse om: Type mismatch - og herefter 3 rækker i regnearket - en dato - og tallet 1 i en anden kolonne.
Jeg bruger excel 2007 - og VBA 6.5
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.