Örnek Kod Outlook daki Mailleri Excel'e Aktarma

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