Chào các bạn,
Mình có đoạn code để export mail từ outlook sang excel nhưng không biết thêm vào điề kiện để chỉ lấy những thư UNREAD thôi, bạn nào rành giúp mình với nhé.
Thanks all
Sub ListAllItemsInInbox()
Dim OLF As Outlook.MAPIFolder
Dim CurrUser As String
Dim EmailItemCount As Integer
Dim i As Integer
Dim EmailCount As Integer
Application.ScreenUpdating = False
Sheets("Send").Select
Cells(1, 1).Formula = "Sender"
Cells(1, 2).Formula = "Subject"
Cells(1, 3).Formula = "Recieved"
Cells(1, 4).Formula = "body"
Cells(1, 5).Formula = "Read"
With Range("A1:E1").Font
.Bold = True
.Size = 14
End With
Application.Calculation = xlCalculationManual
Set OLF = GetObject("", _
"Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
EmailItemCount = OLF.Items.Count
i = 0: EmailCount = 0
While i < EmailItemCount
i = i + 1
If i Mod 50 = 0 Then Application.StatusBar = "Reading e-mail messages " & _
Format(i / EmailItemCount, "0%") & "..."
With OLF.Items(i)
EmailCount = EmailCount + 1
Cells(EmailCount + 1, 1).Formula = .SenderName
Cells(EmailCount + 1, 2).Formula = .Subject
Cells(EmailCount + 1, 3).Formula = Format(.ReceivedTime, "dd.mm.yyyy hh:mm")
Cells(EmailCount + 1, 4).Formula = .Body
Cells(EmailCount + 1, 5).Formula = Not .UnRead
End With
Wend
Application.Calculation = xlCalculationAutomatic
Set OLF = Nothing
Columns("A:E").AutoFit
Range("A2").Select
ActiveWindow.FreezePanes = True
ActiveWorkbook.Saved = True
Application.StatusBar = False
End Sub
Mình có đoạn code để export mail từ outlook sang excel nhưng không biết thêm vào điề kiện để chỉ lấy những thư UNREAD thôi, bạn nào rành giúp mình với nhé.
Thanks all
Sub ListAllItemsInInbox()
Dim OLF As Outlook.MAPIFolder
Dim CurrUser As String
Dim EmailItemCount As Integer
Dim i As Integer
Dim EmailCount As Integer
Application.ScreenUpdating = False
Sheets("Send").Select
Cells(1, 1).Formula = "Sender"
Cells(1, 2).Formula = "Subject"
Cells(1, 3).Formula = "Recieved"
Cells(1, 4).Formula = "body"
Cells(1, 5).Formula = "Read"
With Range("A1:E1").Font
.Bold = True
.Size = 14
End With
Application.Calculation = xlCalculationManual
Set OLF = GetObject("", _
"Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
EmailItemCount = OLF.Items.Count
i = 0: EmailCount = 0
While i < EmailItemCount
i = i + 1
If i Mod 50 = 0 Then Application.StatusBar = "Reading e-mail messages " & _
Format(i / EmailItemCount, "0%") & "..."
With OLF.Items(i)
EmailCount = EmailCount + 1
Cells(EmailCount + 1, 1).Formula = .SenderName
Cells(EmailCount + 1, 2).Formula = .Subject
Cells(EmailCount + 1, 3).Formula = Format(.ReceivedTime, "dd.mm.yyyy hh:mm")
Cells(EmailCount + 1, 4).Formula = .Body
Cells(EmailCount + 1, 5).Formula = Not .UnRead
End With
Wend
Application.Calculation = xlCalculationAutomatic
Set OLF = Nothing
Columns("A:E").AutoFit
Range("A2").Select
ActiveWindow.FreezePanes = True
ActiveWorkbook.Saved = True
Application.StatusBar = False
End Sub