baydeniro
Altın Üye
- Katılım
- 26 Ocak 2007
- Mesajlar
- 4,625
- Excel Vers. ve Dili
- Ofis 2016
- Altın Üyelik Bitiş Tarihi
- 20-02-2025
Merhaba arkadaşlar,
Aşağıdaki kod ile Outlook a gelen mailleri Excele indirebilirsiniz. Herkesin faydalanması için kullanımınıza sunarım. Ayrıca üstadlardan bir destek ricam var. Bu koda nasıl bir ekleme yapmak lazım ki Outlooka bağlı tüm mail adreslerinden gelen mailleri indirmesi için nasıl bir ekleme yapmak gerekir ?
Not : Kodlarla ilgili Forum kuralı hakkında bilgisini paylaşan Emir Hüseyin Çoban üstada teşekkür ediyorum.
Aşağıdaki kod ile Outlook a gelen mailleri Excele indirebilirsiniz. Herkesin faydalanması için kullanımınıza sunarım. Ayrıca üstadlardan bir destek ricam var. Bu koda nasıl bir ekleme yapmak lazım ki Outlooka bağlı tüm mail adreslerinden gelen mailleri indirmesi için nasıl bir ekleme yapmak gerekir ?
Not : Kodlarla ilgili Forum kuralı hakkında bilgisini paylaşan Emir Hüseyin Çoban üstada teşekkür ediyorum.
Kod:
[B]Option Explicit
Private lrow As Long, x As Date, oWS As Worksheet
Sub GetFromInbox()
Const olFolderDrafts = 6
Dim olApp As Object, olNS As Object
Dim oRootFldr As Object
Dim lCalcMode As Long
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set oRootFldr = olNS.GetDefaultFolder(olFolderDrafts)
Set oWS = ActiveSheet
x = Date
lrow = 2
lCalcMode = Application.Calculation
Application.Calculation = xlCalculationManual
GetFromFolder oRootFldr
Application.Calculation = lCalcMode
Set oWS = Nothing
Set oRootFldr = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Sub
Private Sub GetFromFolder(oFldr As Object)
Dim oItem As Object, oSubFldr As Object
For Each oItem In oFldr.Items
Range("g1").Value = lrow
If TypeName(oItem) = "MailItem" Then
With oItem
oWS.Cells(lrow, 1).Value = .SenderEmailAddress
oWS.Cells(lrow, 2).Value = .To
oWS.Cells(lrow, 3).Value = .cc
oWS.Cells(lrow, 4).Value = .Subject
oWS.Cells(lrow, 5).Value = .receivedtime
lrow = lrow + 1
End With
End If
Next
For Each oSubFldr In oFldr.Folders
GetFromFolder oSubFldr
Next
End Sub[/B]