Tìm những thư nhận được trong ngày của thư mục Inbox trong Outlook và xuất kết quả thành tập tin Excel

Nhân tiện gần đây có bạn hỏi "Làm thế nào để tìm những thư nhận được trong ngày từ Outlook và xuất kết quả tìm kiếm thành một báo cáo Excel hoàn chỉnh, vì yêu cầu công việc rất cần thao tác này" nên tôi xin viết về chủ đề này.

Trường hợp này ta có thể viết macro VBA trong Outlook giúp thống kê một cách tự động và nhanh chóng mà không cần dò tìm và viết thông tin của từng cái email sang Excel một cách thủ công.

Trong một thư mục email không chỉ chứa mỗi email mà còn có những item khác như tập tin đính kèm theo email. Nếu viết vòng lặp For Each hay For Next theo kiểu "nông dân" thì cũng được nhưng sẽ là thảm họa khi trong thư mục có hàng trăm, thậm chí lên đến hàng nghìn email khác nhau và ngày giờ nhận email cũng khác nhau, như thế code sẽ chạy cực kỳ chậm. May thay, Outlook cung cấp cho chúng ta nhiều đối tượng để tìm kiếm item trong Outlook như AdvancedSearch, Items.Restrict, Table, … bằng truy vấn DASL hay DAV,… giúp cho ra kết quả rất nhanh và chính xác.

Macro dưới đây sử dụng đối tượng Table trong Outlook để tìm kiếm những thư nhận được trong ngày và trả kết quả sang tập tin Excel mới.

Option Explicit

Public Sub CreateSimpleCustomReport()
    Dim objolNS As Outlook.NameSpace
    Dim objolStore As Outlook.Store
    Dim objolFldr As Outlook.Folder
    Dim objolTbAllMails As Outlook.Table
    Dim objolTbUnreadMails As Outlook.Table
    Dim objolRow As Outlook.Row
    Dim objolAcc As Outlook.Account
    Dim objolcolAccs As Outlook.Accounts
    Dim lngRow As Long
    Dim Data() As Variant
    Dim objXlApp As Object
    Dim objXlWb As Object
    Dim objxlSh As Object
    Dim strFilter As String
    Const xlContinuous As Byte = 1
    Const xlOpenXMLWorkbook As Byte = 51
    strFilter = "@SQL=%today(" & Quote("urn:schemas:httpmail:datereceived") & ")%"
    Set objolNS = Application.Session
    Set objXlApp = CreateObject("Excel.Application")
    With objXlApp
        .Visible = True
        .DisplayAlerts = False
        Set objXlWb = .Workbooks.Add 'Tao t?p tin Excel d? làm báo
    End With
    Set objolcolAccs = objolNS.Accounts
    For Each objolAcc In objolcolAccs 'Duy?t qua t?ng tài kho?n email
        Set objolStore = objolAcc.DeliveryStore
        Set objolFldr = objolStore.GetDefaultFolder(olFolderInbox) 'Xác d?nh h?p thu Inbox
        Set objolTbAllMails = objolFldr.GetTable(strFilter) 'Tìm nh?ng thu dã nh?n trong ngày hôm nay
        Set objolTbUnreadMails = objolTbAllMails.Restrict("@SQL=" & Quote("urn:schemas:httpmail:read") & "= 0") 'L?c ra k?t qu? nh?ng thu chua d?c t? k?t qu? tìm ki?m ? trên
        With objolTbAllMails.Columns 'Xác d?nh nh?ng thu?c tính c?a thu c?n l?y thông tin
            .Add "https://schemas.microsoft.com/mapi/proptag/0x0C1A001E" 'PR_SENDER_NAME
            .Add "UnRead" 'Read/Unread, tr? v? ki?u Boolean
            .Add "https://schemas.microsoft.com/mapi/proptag/0x10820040" 'PR_LAST_VERB_EXECUTION_TIME
            .Add "https://schemas.microsoft.com/mapi/proptag/0x10810003" 'PR_LAST_VERB_EXECUTED
            .Add "ReceivedTime" 'Th?i gian nh?n thu
        End With
        Set objxlSh = objXlWb.Sheets.Add 'Thêm Sheet m?i
        With objxlSh
            '.Name = objolAcc.SMTPAddress 'Ð?a ch? email
            .Range("B2").Value = "Account name: " & objolAcc.SMTPAddress 'Tên ngu?i dùng tài kho?n email
            .Range("B3").Value = "Folder: " & objolFldr.Name 'Tên thu m?c Inbox
            .Range("B4").Value = "Date: " & Format$(Date, "dd/mm/yyyy")
            .Range("B5").Value = "Number of incoming mails: " & objolTbAllMails.GetRowCount
            .Range("B6").Value = "Number of unread mails: " & objolTbUnreadMails.GetRowCount
            .Range("B8").Value = "Subject"
            .Range("C8").Value = "From"
            .Range("D8").Value = "Received Time"
            .Range("E8").Value = "Read/Unread"
            .Range("F8").Value = "Reply/Forward"
            .Range("G8").Value = "Reply Time"
        End With
        lngRow = 9 'Dòng cu?i cùng trong Sheet tru?c khi vi?t d? li?u
        With objxlSh 'Ti?n hành d?nh d?ng c?t
            .Range("B:G").EntireColumn.AutoFit 'T? d?ng giãn c?t
            .Range("B8:G8").Font.Bold = True
            .Range("B9").CurrentRegion.Borders.LineStyle = xlContinuous 'Thêm vi?n cho toàn b? b?ng
        End With
        If objolTbAllMails.GetRowCount > 0 Then 'N?u trong ngày hôm nay nh?n du?c 1 thu tr? lên
            Do Until objolTbAllMails.EndOfTable 'Duy?t qua b?ng k?t qu? d? l?y d? li?u
                Set objolRow = objolTbAllMails.GetNextRow
                Data() = objolRow.GetValues 'Ghi k?t qu? tìm ki?m vào m?ng
                With objxlSh 'Ghi d? li?u tìm ki?m t? b?ng ra t?p tin Excel
                    .Cells(lngRow, 2).Value = Data(1) 'Subject
                    .Cells(lngRow, 3).Value = Data(5) 'From
                    .Cells(lngRow, 4).Value = Format$(Data(9), "dd/mm/yyyy hh:mm") 'Received Time
                    Select Case Data(6) 'Read/Unread
                        Case True: .Cells(lngRow, 5).Value = "Unread"
                        Case False: .Cells(lngRow, 5).Value = "Read"
                    End Select
                    .Cells(lngRow, 6).Value = LastVerbText(CByte(Data(8))) 'Reply?
                    .Cells(lngRow, 7).Value = Data(7) 'Reply Time
                End With
                lngRow = lngRow + 1 'Xuong hang khi da ghi xong mot dong
            Loop
            With objxlSh
                .Range("B:G").EntireColumn.AutoFit
                .Range("B9").CurrentRegion.Borders.LineStyle = xlContinuous
                .Cells(lngRow + 1, 2).Value = "Date and Time of Report: " & Format$(Date, "dd/mm/yyyy") & " " & Format$(Time, "hh:mm:ss")
            End With
        Else: objxlSh.Cells(lngRow + 2, 2).Value = "Date and Time of Report: " & Now
        End If
    Next
    With objXlApp
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    Set objolNS = Nothing
    Set objolStore = Nothing
    Set objolFldr = Nothing
    Set objolTbAllMails = Nothing
    Set objolTbUnreadMails = Nothing
    Set objolRow = Nothing
    Set objXlApp = Nothing
    Set objXlWb = Nothing
    Set objxlSh = Nothing
    Set objolAcc = Nothing
    Set objolcolAccs = Nothing
End Sub

Private Function LastVerbText(Value As Byte) As String
    Select Case Value
        Case 102: LastVerbText = "Reply"
        Case 103: LastVerbText = "Reply to all"
        Case 104: LastVerbText = "Forward"
        Case Else: LastVerbText = "None"
    End Select
End Function

Private Function Quote(Text As String) As String
    Quote = Chr(34) & Text & Chr(34)
End Function

Kết quả minh họa sau khi chạy macro:

2086

Chuỗi lọc của bạn chỉ dùng được với Outlook phiên bản tiếng Anh. Gặp tiếng Việt, Hàn, Nhật, Pháp… là chẳng làm ăn được gì.

Đừng vội đánh giá dùng vòng lặp thế này thế kia. Quan trọng là tư duy kỹ thuật code.
Người ta chỉ đơn giản sort items theo ngày một phát, chẳng hạn mới nhất lên đầu, thì chớp mắt xong rồi.

Thường thì nhiều người sẽ viết thủ tục có tham số là giá trị cần lọc, sau đó thiết kế một biểu mẫu có text box để nhập tham số cho thủ tục đó. Lúc đó nhập giá trị unicode đềy được nhé.
Nếu dùng vòng lặp trong trường hợp này thì chương trình sẽ rất rối rắm do phải dùng nhiều câu lệnh if để kiểm tra điều kiện. Tại sao lại không dùng những đối tượng có sẵn như AdvancedSearch, Item.Find, Items.Restrict,… để tìm cho nhanh mà vẫn đạt hiệu quả?
Mục đích của macro này là giúp người dùng liệt kê được danh sách những email nhận được trong ngày vào một tệp Excel. Nếu có vài email thì không sao, chứ số lượng email lên đến cả trăm thì thống kê bằng tay sẽ rất lâu.

Unicode nào chỗ này hả bạn?

strFilter = "@SQL=%today(" & Quote("urn:schemas:httpmail:datereceived") & ")%"

Nếu dùng vòng lặp trong trường hợp này thì chương trình sẽ rất rối rắm

Rối rắm chỗ nào? Bạn úp cái code rối rắm đó lên đây tôi chỉnh lại cho.

Tại sao lại không dùng những đối tượng có sẵn

Không có ai nói không dùng cái nào cả. Chỉ có bạn đi đánh giá này nọ thôi.

Mục đích của macro này là giúp người dùng liệt kê được danh sách những email nhận được trong ngày vào một tệp Excel. Nếu có vài email thì không sao, chứ số lượng email lên đến cả trăm thì thống kê bằng tay sẽ rất lâu.

Không ai nói gì tay hay chân gì ở đây cả. Vẫn bàn về code.

Bạn ơi, nếu bạn nói như vậy thì bạn chẳng biết gì về lập trình Outlook nên tôi xin phép không tiếp chuyện bạn nữa nhé. Bạn cứ tỏ ra tinh tướng mình biết tất rồi tự dưng nhảy xổ vào bài người ta phán này phán nọ trong khi chẳng biết gì về lập trình Outlook.

Trong này có nhiều người như bạn, khi tranh luận đuối lý, thấy người ta phát hiện ra cái sai… không làm gì được thì quay ra công kích cá nhân.

Tôi không bao giờ chấp những câu chữ như thế.

Bạn cứ trao đổi chuyên môn, tôi có khả năng tới đâu sẵn sàng trao đổi với bạn tới đó.

Bạn cứ làm chỗ này đi sẽ biết ai biết, ai chẳng biết.

276673

www.giaiphapexcel.com/diendan/threads/t%C3%ACm-nh%E1%BB%AFng-th%C6%B0-nh%E1%BA%ADn-%C4%91%C6%B0%E1%BB%A3c-trong-ng%C3%A0y-c%E1%BB%A7a-th%C6%B0-m%E1%BB%A5c-inbox-trong-outlook-v%C3%A0-xu%E1%BA%A5t-k%E1%BA%BFt-qu%E1%BA%A3-th%C3%A0nh-t%E1%BA%ADp-tin-excel.160581/#post-1072210

Khóa học SprinGO phù hợp

Khoá học Trưởng phòng nhân sự

Nguồn nhân lực là một trong Tứ trụ kinh doanh của doanh nghiệp, có tác động tới sự tồn tại và phát triển bền...

Xem khóa học