• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: VBA - eport počtu emailů z outlooku do excelu

Zaslal/a martinx0x 9.10.2017 22:28

ahoj všem, potřeboval bych poradit, jak z excelu vytahnout počet emailů za jednotlivé dny z outlooku - mám již funkční makro na vytažení jakékoli složky, zajímá mě odeslaná pošta a přijatá pošta.
Odeslanou poštu mám již vytaženou z makra, které vkládám níže.
Jde mi ale o to, že veškerou příchozí poštu co zpracuji rozřazuji do složek. Vytvořil jsem si tedy vlastní filtr vyhledávání viz: https://imgur.com/fTl0Xnr
Bohužel se jedná o jakýsi filtr pošty a makro nelze použít - jakoby tu složku neviděl, lze to nějak vyřešit korekcí makra?

VBA na odchozí emaily funguje na jedničku, ale potřeboval bych ho upravit i pro filtr - konkrétně vyhledávací složku "Přijatá pošta". Všem děkuji za případnou pomoc.


Sub Odeslane_emaily()

' Set Variables
Dim objOutlook As Object, objnSpace As Object, objFolder As Object
Dim EmailCount As Integer, DateCount As Integer, iCount As Integer
Dim myDate As Date
Dim arrEmailDates()

' Get Outlook Object
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")

' Get Folder Object
On Error Resume Next
Set objFolder = objnSpace.Folders("osobni@email.cz").Folders("Odeslaná pošta")
If Err.Number <> 0 Then
Err.Clear
MsgBox "No such folder."
Set objFolder = Nothing
Set objnSpace = Nothing
Set objOutlook = Nothing
Exit Sub
End If

' Put ReceivedTimes in array
EmailCount = objFolder.Items.Count
For iCount = 1 To EmailCount
With objFolder.Items(iCount)
ReDim Preserve arrEmailDates(iCount - 1)
arrEmailDates(iCount - 1) = DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime))
End With
Next iCount

' Clear Outlook objects
Set objFolder = Nothing
Set objnSpace = Nothing
Set objOutlook = Nothing

' Count the emails dates equal to active cell
Sheets("Odeslaná").Range("A1").Select
Do Until IsEmpty(ActiveCell)

DateCount = 0
myDate = ActiveCell.Value

For i = 0 To UBound(arrEmailDates) - 1
If arrEmailDates(i) = myDate Then DateCount = DateCount + 1
Next i

Selection.Offset(0, 1).Activate
ActiveCell.Value = DateCount
Selection.Offset(1, -1).Activate
Loop
End Sub

Zaslat odpověď >

---

xlnc(11.10.2017 18:10)#037903

Sám do Outlooku dělám málo, ale tuším, že jde o kolekci Stores, zkuste ještě Google a "Outlook Search Folder":
http://techdroppings.blogspot.cz/2013/07/vba-get-contents-of-search-folder.htmlcitovat

martinx0x(11.10.2017 21:51)#037905

vyzkoušel jsem to a lehce poupravil, ale pořád nefunguje :/.. respektive funguje, ale zasekne se na čísle 840 a netuším proč, mám tam přes 5000 emailů, použil jsem:


Sub ListSubjectLinesOfEmailsInASearchFolder()
Dim StoreName As String
Dim FolderName As String
StoreName = "myemail@mycorp.com"
FolderName = "Pending Terminations"
Dim colStores As Outlook.Stores
Dim oStore As Outlook.store
Dim oSearchFolders As Outlook.Folders
Dim oFolder As Outlook.Folder
Dim mail As Outlook.MailItem

On Error Resume Next
Set oFolder = Session.Stores.Item(StoreName).GetSearchFolders(FolderName)
For Each mail In oFolder.Items
Debug.Print mail.Subject
Next
End Sub
citovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse