gicimi
Yeni Üye
- Katılım
- 18 Haz 2018
- Mesajlar
- 64
- En iyi yanıt
- 0
- Puanları
- 18
- Yaş
- 36
- Konum
- Ankara
- Ad Soyad
- Hüseyin Yılmaz
- Office Vers.
- Office 2016 Pro
Merhabalar,
Outlook yer alan mailleri excel'e aktarabilirsiniz.
Outlook yer alan mailleri excel'e aktarabilirsiniz.
Kod:
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