In mail outlook hàng loạt có file đính kèm

Liên hệ QC

HNT1

Thành viên mới
Tham gia
29/3/21
Bài viết
5
Được thích
0
Chào các bác.

Em cần in 250 mail outlook 2016 có file đính kèm (in cả nội dung mail và file đính kèm). Có bác nào biết cách in tự động hàng loạt không chỉ giúp em với ạ.

Em cảm ơn các bác.
 
Có nhiều cách viết code VBA trong trường hợp này, ở đây tôi xin trình bày một cách như sau (giả sử tệp đính kèm chỉ bao gồm phần mở rộng ".xls", ".xlsm", ".xlsb", ".xlsx", ".doc", ".docx", ".docm", ".pdf":
Chọn những thư cần in trong Outlook.
Mã:
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
#Else
    Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If

Private Sub PrintEmailBodyAndAttachments()
    Dim objMail As Outlook.MailItem
    Dim objSel As Outlook.Selection
    Dim objAtt As Outlook.Attachment
    Dim i As LongPtr, j As LongPtr, lngNumAtt As LongPtr
    Dim strAttFilePath As String
    i = 1
    SetDefaultPrinter "Tên máy in"
    Set objSel = Application.ActiveExplorer.Selection
    For i = 1 To objSel.Count
        If TypeOf objSel.Item(i) Is Outlook.MailItem Then
            Set objMail = objSel.Item(i)
            With objMail
                .PrintOut
                If .Attachments.Count > 0 Then
                    For j = 1 To .Attachments.Count
                        Set objAtt = .Attachments.Item(j)
                        strAttFilePath = Environ$("TEMP") & "\" & objAtt.FileName
                        objAtt.SaveAsFile strAttFilePath
                        Select Case GetFileExtension(strAttFilePath)
                            Case ".xls", ".xlsm", ".xlsb", ".xlsx", ".doc", ".docx", ".docm", ".pdf"
                                ShellExecute 0, "print", strAttFilePath, vbNullString, vbNullString, 0
                        End Select
                        DeleteFile strAttFilePath
                    Next
                End If
            End With
        End If
    Next
    Set objMail = Nothing
    Set objSel = Nothing
    Set objAtt = Nothing
End Sub

Private Sub SetDefaultPrinter(PrinterName As String, Optional ComputerName As String = ".")
    Dim Printer As Object, Printers As Object, WMIService As Object
    Set WMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & ComputerName & "\root\cimv2")
    Set Printers = WMIService.ExecQuery("Select * from Win32_Printer Where Name = '" & PrinterName & "'")
    For Each Printer In Printers
        Printer.SetDefaultPrinter
    Next
    Set Printer = Nothing
    Set Printers = Nothing
    Set WMIService = Nothing
End Sub

Private Function GetFileExtension(FileName As String) As String
    On Error Resume Next
    GetFileExtension = Mid(FileName, InStrRev(FileName, "."))
    If Err.Number = 5 Then
        GetFileExtension = vbNullString
    End If
End Function
 
bạn giải giùm mình bài này với. Dùng hàm gì để đếm số hành khách ở cột nơi đến ra cột số hành khách/chuyến. Như dòng đầu có 4 hành khách. Ngăn cách giữa các hành khách là dấu +
 

File đính kèm

  • C638DB59-CC1F-42B0-AA00-E09B0DD6E307.png
    C638DB59-CC1F-42B0-AA00-E09B0DD6E307.png
    202.7 KB · Đọc: 5
Có nhiều cách viết code VBA trong trường hợp này, ở đây tôi xin trình bày một cách như sau (giả sử tệp đính kèm chỉ bao gồm phần mở rộng ".xls", ".xlsm", ".xlsb", ".xlsx", ".doc", ".docx", ".docm", ".pdf":
Chọn những thư cần in trong Outlook.
Mã:
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
#Else
    Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If

Private Sub PrintEmailBodyAndAttachments()
    Dim objMail As Outlook.MailItem
    Dim objSel As Outlook.Selection
    Dim objAtt As Outlook.Attachment
    Dim i As LongPtr, j As LongPtr, lngNumAtt As LongPtr
    Dim strAttFilePath As String
    i = 1
    SetDefaultPrinter "Tên máy in"
    Set objSel = Application.ActiveExplorer.Selection
    For i = 1 To objSel.Count
        If TypeOf objSel.Item(i) Is Outlook.MailItem Then
            Set objMail = objSel.Item(i)
            With objMail
                .PrintOut
                If .Attachments.Count > 0 Then
                    For j = 1 To .Attachments.Count
                        Set objAtt = .Attachments.Item(j)
                        strAttFilePath = Environ$("TEMP") & "\" & objAtt.FileName
                        objAtt.SaveAsFile strAttFilePath
                        Select Case GetFileExtension(strAttFilePath)
                            Case ".xls", ".xlsm", ".xlsb", ".xlsx", ".doc", ".docx", ".docm", ".pdf"
                                ShellExecute 0, "print", strAttFilePath, vbNullString, vbNullString, 0
                        End Select
                        DeleteFile strAttFilePath
                    Next
                End If
            End With
        End If
    Next
    Set objMail = Nothing
    Set objSel = Nothing
    Set objAtt = Nothing
End Sub

Private Sub SetDefaultPrinter(PrinterName As String, Optional ComputerName As String = ".")
    Dim Printer As Object, Printers As Object, WMIService As Object
    Set WMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & ComputerName & "\root\cimv2")
    Set Printers = WMIService.ExecQuery("Select * from Win32_Printer Where Name = '" & PrinterName & "'")
    For Each Printer In Printers
        Printer.SetDefaultPrinter
    Next
    Set Printer = Nothing
    Set Printers = Nothing
    Set WMIService = Nothing
End Sub

Private Function GetFileExtension(FileName As String) As String
    On Error Resume Next
    GetFileExtension = Mid(FileName, InStrRev(FileName, "."))
    If Err.Number = 5 Then
        GetFileExtension = vbNullString
    End If
End Function

Có cách nào lấy toàn bộ file đính kèm từ 1 địa chỉ mail gửi đến không bạn.
Nếu được nhờ bạn hướng dẫn giúp.
 
Có cách nào lấy toàn bộ file đính kèm từ 1 địa chỉ mail gửi đến không bạn.
Nếu được nhờ bạn hướng dẫn giúp.
Đặt code dưới đây vào Module trong trình soạn thảo VBE của Outlook (nhớ kích hoạt tab Developer):
Lưu ý: Macro này sẽ tìm kiếm các email trong thư mục Inbox mặc định trong Outlook.
Mã:
Option Explicit

Public Sub DownloadAttachments(SenderEmailAddress As String)
    Dim objMail As Outlook.MailItem
    Dim objAtt As Outlook.Attachment
    Dim objFSO As Object
    Dim strRCDatePath As String, strFolderPath As String, strSenderPath As String
    Dim i As Long, j As Long
    Dim strFilter As String, strSenderEmailAddress As String
    Dim colItems As Outlook.Items
    Dim objInbox As Outlook.Folder
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strFolderPath = Environ$("USERPROFILE") & "\Documents\OutlookAttachments\" 'Thu muc luu tap tin dinh kem, mac dinh: C:\<nguoidung>
    If Not objFSO.FolderExists(strFolderPath) Then objFSO.CreateFolder strFolderPath
    Const PR_SENDER_EMAIL_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x0C1F001F"
    Const PR_HASATTACH As String = "http://schemas.microsoft.com/mapi/proptag/0x0E1B000B"
    strSenderEmailAddress = SenderEmailAddress 'Dia chi email nguoi gui
    strFilter = "@SQL=" & Quote(PR_SENDER_EMAIL_ADDRESS) & " = '" & strSenderEmailAddress & "' AND " & Quote(PR_HASATTACH) & "=1"
    Set objInbox = Application.Session.GetDefaultFolder(olFolderInbox)
    Set colItems = objInbox.Items.Restrict(strFilter)
    For j = 1 To colItems.Count
        Set objMail = colItems.Item(j)
        With objMail
            If Not objFSO.FolderExists(strFolderPath & GetDateFromReceivedTime(.ReceivedTime)) Then
                strRCDatePath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime)
                objFSO.CreateFolder strRCDatePath
            Else: strRCDatePath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime)
            End If
            If Not objFSO.FolderExists(strFolderPath & GetDateFromReceivedTime(.ReceivedTime) & "\" & .SenderName) Then
                strSenderPath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime) & "\" & .SenderName
                objFSO.CreateFolder strSenderPath
            Else: strSenderPath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime) & "\" & .SenderName
            End If
            For i = 1 To .Attachments.Count
                Set objAtt = .Attachments.Item(i)
                If objFSO.FileExists(strSenderPath & "\" & objAtt.filename) Then
                    objFSO.DeleteFile strSenderPath & "\" & objAtt.filename
                End If
                objAtt.SaveAsFile strSenderPath & "\" & objAtt.filename
            Next i
        End With
    Next
    Shell "explorer """ & strFolderPath & "", vbNormalFocus
End Sub

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

Private Function GetDateFromReceivedTime(ReceivedDateString As String) As String
    Dim RDString As String
    RDString = Trim(Format(Left(ReceivedDateString, InStr(ReceivedDateString, " ")), "dd-mm-yyyy"))
    GetDateFromReceivedTime = RDString
End Function

Khi chạy thủ tục, thay tham số SenderEmailAddress thành địa chỉ email thích hợp, ví dụ:
Mã:
Private Sub Test()
    Call DownloadAttachments("abc@gmail.com")
End Sub
 
Lần chỉnh sửa cuối:
Đặt code dưới đây vào Module trong trình soạn thảo VBE của Outlook (nhớ kích hoạt tab Developer):
Lưu ý: Macro này sẽ tìm kiếm các email trong thư mục Inbox mặc định trong Outlook.
Mã:
Option Explicit

Public Sub DownloadAttachments(SenderEmailAddress As String)
    Dim objMail As Outlook.MailItem
    Dim objAtt As Outlook.Attachment
    Dim objFSO As Object
    Dim strRCDatePath As String, strFolderPath As String, strSenderPath As String
    Dim i As Long, j As Long
    Dim strFilter As String, strSenderEmailAddress As String
    Dim colItems As Outlook.Items
    Dim objInbox As Outlook.Folder
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strFolderPath = Environ$("USERPROFILE") & "\Documents\OutlookAttachments\" 'Thu muc luu tap tin dinh kem, mac dinh: C:\<nguoidung>
    If Not objFSO.FolderExists(strFolderPath) Then objFSO.CreateFolder strFolderPath
    Const PR_SENDER_EMAIL_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x0C1F001F"
    Const PR_HASATTACH As String = "http://schemas.microsoft.com/mapi/proptag/0x0E1B000B"
    strSenderEmailAddress = SenderEmailAddress 'Dia chi email nguoi gui
    strFilter = "@SQL=" & Quote(PR_SENDER_EMAIL_ADDRESS) & " = '" & strSenderEmailAddress & "' AND " & Quote(PR_HASATTACH) & "=1"
    Set objInbox = Application.Session.GetDefaultFolder(olFolderInbox)
    Set colItems = objInbox.Items.Restrict(strFilter)
    For j = 1 To colItems.Count
        Set objMail = colItems.Item(j)
        With objMail
            If Not objFSO.FolderExists(strFolderPath & GetDateFromReceivedTime(.ReceivedTime)) Then
                strRCDatePath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime)
                objFSO.CreateFolder strRCDatePath
            Else: strRCDatePath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime)
            End If
            If Not objFSO.FolderExists(strFolderPath & GetDateFromReceivedTime(.ReceivedTime) & "\" & .SenderName) Then
                strSenderPath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime) & "\" & .SenderName
                objFSO.CreateFolder strSenderPath
            Else: strSenderPath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime) & "\" & .SenderName
            End If
            For i = 1 To .Attachments.Count
                Set objAtt = .Attachments.Item(i)
                If objFSO.FileExists(strSenderPath & "\" & objAtt.filename) Then
                    objFSO.DeleteFile strSenderPath & "\" & objAtt.filename
                End If
                objAtt.SaveAsFile strSenderPath & "\" & objAtt.filename
            Next i
        End With
    Next
    Shell "explorer """ & strFolderPath & "", vbNormalFocus
End Sub

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

Private Function GetDateFromReceivedTime(ReceivedDateString As String) As String
    Dim RDString As String
    RDString = Trim(Format(Left(ReceivedDateString, InStr(ReceivedDateString, " ")), "dd-mm-yyyy"))
    GetDateFromReceivedTime = RDString
End Function

Khi chạy thủ tục, thay tham số SenderEmailAddress thành địa chỉ email thích hợp, ví dụ:
Mã:
Private Sub Test()
    Call DownloadAttachments("abc@gmail.com")
End Sub
Thật tuyệt vời, những dòng code của anh chạy cực nhanh và chính xác.
Nhờ anh chỉ giúp em nếu muốn thay đổi thư mục mặc định tìm kiếm là Inbox sang 1 thư mục cá nhân khác, và giới hạn thời gian tìm kiếm thì phải sửa code như thế nào ạ.
 
Thật tuyệt vời, những dòng code của anh chạy cực nhanh và chính xác.
Nhờ anh chỉ giúp em nếu muốn thay đổi thư mục mặc định tìm kiếm là Inbox sang 1 thư mục cá nhân khác, và giới hạn thời gian tìm kiếm thì phải sửa code như thế nào ạ.
Sửa lại một chút macro ở trên.
Code dưới đây hiển thị hộp thoại chọn thư mục email để tìm kiếm:
Mã:
Option Explicit

Public Sub DownloadAttachments(SenderEmailAddress As String, StartDate As Date, EndDate As Date)
    Dim objMail As Outlook.MailItem
    Dim objAtt As Outlook.Attachment
    Dim objPA As Outlook.PropertyAccessor
    Dim objFSO As Object
    Dim strRCDatePath As String, strFolderPath As String, strSenderPath As String
    Dim dteStartDate As Date, dteEndDate As Date, dteStartDateUTC As Date, dteEndDateUTC As Date
    Dim i As Long, j As Long
    Dim strFilter As String, strSenderEmailAddress As String
    Dim colItems As Outlook.Items
    Dim objFolder As Outlook.Folder
    Const PR_SENDER_EMAIL_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x0C1F001F"
    Const PR_HASATTACH As String = "http://schemas.microsoft.com/mapi/proptag/0x0E1B000B"
    dteStartDate = StartDate 'Ngay bat dau, vd: #1/1#2021#
    dteEndDate = EndDate 'Ngay ket thuc, vd: #1/1/2022#
    Set objMail = Application.CreateItem(olMailItem)
    With objMail
        Set objPA = .PropertyAccessor
        dteStartDateUTC = objPA.LocalTimeToUTC(dteStartDate)
        dteEndDateUTC = objPA.LocalTimeToUTC(dteEndDate)
        .Close olDiscard
    End With
    strSenderEmailAddress = SenderEmailAddress 'Dia chi email nguoi gui
    strFilter = "@SQL=" & Quote(PR_SENDER_EMAIL_ADDRESS) & " = '" & strSenderEmailAddress & "' AND " & Quote(PR_HASATTACH) & "=1 AND " & _
                Quote("urn:schemas:httpmail:datereceived") & " > " & Chr(39) & dteStartDateUTC & Chr(39) & " And " & Quote("urn:schemas:httpmail:datereceived") & " < " & Chr(39) & dteEndDateUTC & Chr(39)
    strFolderPath = Environ$("USERPROFILE") & "\Documents\OutlookAttachments\" 'Thu muc luu tap tin dinh kem, mac dinh: C:\<nguoidung>
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If Not objFSO.FolderExists(strFolderPath) Then objFSO.CreateFolder strFolderPath
    On Error Resume Next
    Set objFolder = Application.Session.PickFolder
    If Not objFolder Is Nothing Then
        Set colItems = objFolder.Items.Restrict(strFilter)
        For j = 1 To colItems.Count
            Set objMail = colItems.Item(j)
            With objMail
                If Not objFSO.FolderExists(strFolderPath & GetDateFromReceivedTime(.ReceivedTime)) Then
                    strRCDatePath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime)
                    objFSO.CreateFolder strRCDatePath
                Else: strRCDatePath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime)
                End If
                If Not objFSO.FolderExists(strFolderPath & GetDateFromReceivedTime(.ReceivedTime) & "\" & .SenderName) Then
                    strSenderPath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime) & "\" & .SenderName
                    objFSO.CreateFolder strSenderPath
                Else: strSenderPath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime) & "\" & .SenderName
                End If
                For i = 1 To .Attachments.Count
                    Set objAtt = .Attachments.Item(i)
                    If objFSO.FileExists(strSenderPath & "\" & objAtt.DisplayName) Then
                        objFSO.DeleteFile strSenderPath & "\" & objAtt.DisplayName
                    End If
                    objAtt.SaveAsFile strSenderPath & "\" & objAtt.DisplayName
                Next i
            End With
        Next
        Shell "explorer """ & strFolderPath & "", vbNormalFocus
    End If
End Sub

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

Private Function GetDateFromReceivedTime(ReceivedDateString As String) As String
    Dim RDString As String
    RDString = Trim(Format(Left(ReceivedDateString, InStr(ReceivedDateString, " ")), "dd-mm-yyyy"))
    GetDateFromReceivedTime = RDString
End Function

Sử dụng macro để tìm kiếm và tải xuống tập tin đính kèm từ SenderEmailAddress, trong khoảng thời gian từ ngày StartDate đến ngày EndDate:

Mã:
Private Sub Test()
    Call DownloadAttachments("abc@gmail.com", #1/1/2021#, #1/1/2022#)
End Sub
 
Lần chỉnh sửa cuối:
Sửa lại một chút macro ở trên.
Code dưới đây hiển thị hộp thoại chọn thư mục email để tìm kiếm:
Mã:
Option Explicit

Public Sub DownloadAttachments(SenderEmailAddress As String, StartDate As Date, EndDate As Date)
    Dim objMail As Outlook.MailItem
    Dim objAtt As Outlook.Attachment
    Dim objPA As Outlook.PropertyAccessor
    Dim objFSO As Object
    Dim strRCDatePath As String, strFolderPath As String, strSenderPath As String
    Dim dteStartDate As Date, dteEndDate As Date, dteStartDateUTC As Date, dteEndDateUTC As Date
    Dim i As Long, j As Long
    Dim strFilter As String, strSenderEmailAddress As String
    Dim colItems As Outlook.Items
    Dim objFolder As Outlook.Folder
    Const PR_SENDER_EMAIL_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x0C1F001F"
    Const PR_HASATTACH As String = "http://schemas.microsoft.com/mapi/proptag/0x0E1B000B"
    dteStartDate = StartDate 'Ngay bat dau, vd: #1/1#2021#
    dteEndDate = EndDate 'Ngay ket thuc, vd: #1/1/2022#
    Set objMail = Application.CreateItem(olMailItem)
    With objMail
        Set objPA = .PropertyAccessor
        dteStartDateUTC = objPA.LocalTimeToUTC(dteStartDate)
        dteEndDateUTC = objPA.LocalTimeToUTC(dteEndDate)
        .Close olDiscard
    End With
    strSenderEmailAddress = SenderEmailAddress 'Dia chi email nguoi gui
    strFilter = "@SQL=" & Quote(PR_SENDER_EMAIL_ADDRESS) & " = '" & strSenderEmailAddress & "' AND " & Quote(PR_HASATTACH) & "=1 AND " & _
                Quote("urn:schemas:httpmail:datereceived") & " > " & Chr(39) & dteStartDateUTC & Chr(39) & " And " & Quote("urn:schemas:httpmail:datereceived") & " < " & Chr(39) & dteEndDateUTC & Chr(39)
    strFolderPath = Environ$("USERPROFILE") & "\Documents\OutlookAttachments\" 'Thu muc luu tap tin dinh kem, mac dinh: C:\<nguoidung>
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If Not objFSO.FolderExists(strFolderPath) Then objFSO.CreateFolder strFolderPath
    On Error Resume Next
    Set objFolder = Application.Session.PickFolder
    If Not objFolder Is Nothing Then
        Set colItems = objFolder.Items.Restrict(strFilter)
        For j = 1 To colItems.Count
            Set objMail = colItems.Item(j)
            With objMail
                If Not objFSO.FolderExists(strFolderPath & GetDateFromReceivedTime(.ReceivedTime)) Then
                    strRCDatePath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime)
                    objFSO.CreateFolder strRCDatePath
                Else: strRCDatePath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime)
                End If
                If Not objFSO.FolderExists(strFolderPath & GetDateFromReceivedTime(.ReceivedTime) & "\" & .SenderName) Then
                    strSenderPath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime) & "\" & .SenderName
                    objFSO.CreateFolder strSenderPath
                Else: strSenderPath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime) & "\" & .SenderName
                End If
                For i = 1 To .Attachments.Count
                    Set objAtt = .Attachments.Item(i)
                    If objFSO.FileExists(strSenderPath & "\" & objAtt.DisplayName) Then
                        objFSO.DeleteFile strSenderPath & "\" & objAtt.DisplayName
                    End If
                    objAtt.SaveAsFile strSenderPath & "\" & objAtt.DisplayName
                Next i
            End With
        Next
        Shell "explorer """ & strFolderPath & "", vbNormalFocus
    End If
End Sub

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

Private Function GetDateFromReceivedTime(ReceivedDateString As String) As String
    Dim RDString As String
    RDString = Trim(Format(Left(ReceivedDateString, InStr(ReceivedDateString, " ")), "dd-mm-yyyy"))
    GetDateFromReceivedTime = RDString
End Function

Sử dụng macro để tìm kiếm và tải xuống tập tin đính kèm từ SenderEmailAddress, trong khoảng thời gian từ ngày StartDate đến ngày EndDate:

Mã:
Private Sub Test()
    Call DownloadAttachments("abc@gmail.com", #1/1/2021#, #1/1/2022#)
End Sub
Cảm ơn anh rất nhiều, code chạy rất chính xác ạ. :D
 
Sửa lại một chút macro ở trên.
Code dưới đây hiển thị hộp thoại chọn thư mục email để tìm kiếm:
Mã:
Option Explicit

Public Sub DownloadAttachments(SenderEmailAddress As String, StartDate As Date, EndDate As Date)
    Dim objMail As Outlook.MailItem
    Dim objAtt As Outlook.Attachment
    Dim objPA As Outlook.PropertyAccessor
    Dim objFSO As Object
    Dim strRCDatePath As String, strFolderPath As String, strSenderPath As String
    Dim dteStartDate As Date, dteEndDate As Date, dteStartDateUTC As Date, dteEndDateUTC As Date
    Dim i As Long, j As Long
    Dim strFilter As String, strSenderEmailAddress As String
    Dim colItems As Outlook.Items
    Dim objFolder As Outlook.Folder
    Const PR_SENDER_EMAIL_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x0C1F001F"
    Const PR_HASATTACH As String = "http://schemas.microsoft.com/mapi/proptag/0x0E1B000B"
    dteStartDate = StartDate 'Ngay bat dau, vd: #1/1#2021#
    dteEndDate = EndDate 'Ngay ket thuc, vd: #1/1/2022#
    Set objMail = Application.CreateItem(olMailItem)
    With objMail
        Set objPA = .PropertyAccessor
        dteStartDateUTC = objPA.LocalTimeToUTC(dteStartDate)
        dteEndDateUTC = objPA.LocalTimeToUTC(dteEndDate)
        .Close olDiscard
    End With
    strSenderEmailAddress = SenderEmailAddress 'Dia chi email nguoi gui
    strFilter = "@SQL=" & Quote(PR_SENDER_EMAIL_ADDRESS) & " = '" & strSenderEmailAddress & "' AND " & Quote(PR_HASATTACH) & "=1 AND " & _
                Quote("urn:schemas:httpmail:datereceived") & " > " & Chr(39) & dteStartDateUTC & Chr(39) & " And " & Quote("urn:schemas:httpmail:datereceived") & " < " & Chr(39) & dteEndDateUTC & Chr(39)
    strFolderPath = Environ$("USERPROFILE") & "\Documents\OutlookAttachments\" 'Thu muc luu tap tin dinh kem, mac dinh: C:\<nguoidung>
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If Not objFSO.FolderExists(strFolderPath) Then objFSO.CreateFolder strFolderPath
    On Error Resume Next
    Set objFolder = Application.Session.PickFolder
    If Not objFolder Is Nothing Then
        Set colItems = objFolder.Items.Restrict(strFilter)
        For j = 1 To colItems.Count
            Set objMail = colItems.Item(j)
            With objMail
                If Not objFSO.FolderExists(strFolderPath & GetDateFromReceivedTime(.ReceivedTime)) Then
                    strRCDatePath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime)
                    objFSO.CreateFolder strRCDatePath
                Else: strRCDatePath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime)
                End If
                If Not objFSO.FolderExists(strFolderPath & GetDateFromReceivedTime(.ReceivedTime) & "\" & .SenderName) Then
                    strSenderPath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime) & "\" & .SenderName
                    objFSO.CreateFolder strSenderPath
                Else: strSenderPath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime) & "\" & .SenderName
                End If
                For i = 1 To .Attachments.Count
                    Set objAtt = .Attachments.Item(i)
                    If objFSO.FileExists(strSenderPath & "\" & objAtt.DisplayName) Then
                        objFSO.DeleteFile strSenderPath & "\" & objAtt.DisplayName
                    End If
                    objAtt.SaveAsFile strSenderPath & "\" & objAtt.DisplayName
                Next i
            End With
        Next
        Shell "explorer """ & strFolderPath & "", vbNormalFocus
    End If
End Sub

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

Private Function GetDateFromReceivedTime(ReceivedDateString As String) As String
    Dim RDString As String
    RDString = Trim(Format(Left(ReceivedDateString, InStr(ReceivedDateString, " ")), "dd-mm-yyyy"))
    GetDateFromReceivedTime = RDString
End Function

Sử dụng macro để tìm kiếm và tải xuống tập tin đính kèm từ SenderEmailAddress, trong khoảng thời gian từ ngày StartDate đến ngày EndDate:

Mã:
Private Sub Test()
    Call DownloadAttachments("abc@gmail.com", #1/1/2021#, #1/1/2022#)
End Sub
Cho mình hỏi chút.
Khi mình chạy code thì chỉ tạo ra foder ngày có mail đến thôi. Còn file đính kèm thì không có.
Mình chỉ coppy dán code và thay đổi địa chỉ mail. Không rõ là có cần chỉnh sửa gì nữa không.
Nhờ bạn chỉ giúp.

1669717958419.png
 
Cho mình hỏi chút.
Khi mình chạy code thì chỉ tạo ra foder ngày có mail đến thôi. Còn file đính kèm thì không có.
Mình chỉ coppy dán code và thay đổi địa chỉ mail. Không rõ là có cần chỉnh sửa gì nữa không.
Nhờ bạn chỉ giúp.

View attachment 284038
Lạ nhỉ, thông thường những thư mục đó chỉ được tạo khi tìm được những email thỏa mãn tiêu chí tìm kiếm. Bạn thử chạy lại xem sao nhé.
 
Sửa lại một chút macro ở trên.
Code dưới đây hiển thị hộp thoại chọn thư mục email để tìm kiếm:
Mã:
Option Explicit

Public Sub DownloadAttachments(SenderEmailAddress As String, StartDate As Date, EndDate As Date)
    Dim objMail As Outlook.MailItem
    Dim objAtt As Outlook.Attachment
    Dim objPA As Outlook.PropertyAccessor
    Dim objFSO As Object
    Dim strRCDatePath As String, strFolderPath As String, strSenderPath As String
    Dim dteStartDate As Date, dteEndDate As Date, dteStartDateUTC As Date, dteEndDateUTC As Date
    Dim i As Long, j As Long
    Dim strFilter As String, strSenderEmailAddress As String
    Dim colItems As Outlook.Items
    Dim objFolder As Outlook.Folder
    Const PR_SENDER_EMAIL_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x0C1F001F"
    Const PR_HASATTACH As String = "http://schemas.microsoft.com/mapi/proptag/0x0E1B000B"
    dteStartDate = StartDate 'Ngay bat dau, vd: #1/1#2021#
    dteEndDate = EndDate 'Ngay ket thuc, vd: #1/1/2022#
    Set objMail = Application.CreateItem(olMailItem)
    With objMail
        Set objPA = .PropertyAccessor
        dteStartDateUTC = objPA.LocalTimeToUTC(dteStartDate)
        dteEndDateUTC = objPA.LocalTimeToUTC(dteEndDate)
        .Close olDiscard
    End With
    strSenderEmailAddress = SenderEmailAddress 'Dia chi email nguoi gui
    strFilter = "@SQL=" & Quote(PR_SENDER_EMAIL_ADDRESS) & " = '" & strSenderEmailAddress & "' AND " & Quote(PR_HASATTACH) & "=1 AND " & _
                Quote("urn:schemas:httpmail:datereceived") & " > " & Chr(39) & dteStartDateUTC & Chr(39) & " And " & Quote("urn:schemas:httpmail:datereceived") & " < " & Chr(39) & dteEndDateUTC & Chr(39)
    strFolderPath = Environ$("USERPROFILE") & "\Documents\OutlookAttachments\" 'Thu muc luu tap tin dinh kem, mac dinh: C:\<nguoidung>
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If Not objFSO.FolderExists(strFolderPath) Then objFSO.CreateFolder strFolderPath
    On Error Resume Next
    Set objFolder = Application.Session.PickFolder
    If Not objFolder Is Nothing Then
        Set colItems = objFolder.Items.Restrict(strFilter)
        For j = 1 To colItems.Count
            Set objMail = colItems.Item(j)
            With objMail
                If Not objFSO.FolderExists(strFolderPath & GetDateFromReceivedTime(.ReceivedTime)) Then
                    strRCDatePath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime)
                    objFSO.CreateFolder strRCDatePath
                Else: strRCDatePath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime)
                End If
                If Not objFSO.FolderExists(strFolderPath & GetDateFromReceivedTime(.ReceivedTime) & "\" & .SenderName) Then
                    strSenderPath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime) & "\" & .SenderName
                    objFSO.CreateFolder strSenderPath
                Else: strSenderPath = strFolderPath & GetDateFromReceivedTime(.ReceivedTime) & "\" & .SenderName
                End If
                For i = 1 To .Attachments.Count
                    Set objAtt = .Attachments.Item(i)
                    If objFSO.FileExists(strSenderPath & "\" & objAtt.DisplayName) Then
                        objFSO.DeleteFile strSenderPath & "\" & objAtt.DisplayName
                    End If
                    objAtt.SaveAsFile strSenderPath & "\" & objAtt.DisplayName
                Next i
            End With
        Next
        Shell "explorer """ & strFolderPath & "", vbNormalFocus
    End If
End Sub

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

Private Function GetDateFromReceivedTime(ReceivedDateString As String) As String
    Dim RDString As String
    RDString = Trim(Format(Left(ReceivedDateString, InStr(ReceivedDateString, " ")), "dd-mm-yyyy"))
    GetDateFromReceivedTime = RDString
End Function

Sử dụng macro để tìm kiếm và tải xuống tập tin đính kèm từ SenderEmailAddress, trong khoảng thời gian từ ngày StartDate đến ngày EndDate:

Mã:
Private Sub Test()
    Call DownloadAttachments("abc@gmail.com", #1/1/2021#, #1/1/2022#)
End Sub
Em chào Anh,
Giống như code này nếu chỉ muốn lấy những file đính kèm dạng excel và pdf (Hoặc tìm và lọc theo dạng tên file) trong nguyên 1 thư mục luôn thì có được không ạ, vì như bên em sử dụng những địa chỉ email chuyên để nhận file từ nhiều khách hàng, hàng ngày em phải trích lưu những file đính kèm của nhiều bên gửi tới hộp mail chung đó nên việc chỉ định lấy theo từng Sender sẽ không hiệu quả. Mong anh hướng dẫn giúp.
 
Em chào Anh,
Giống như code này nếu chỉ muốn lấy những file đính kèm dạng excel và pdf (Hoặc tìm và lọc theo dạng tên file) trong nguyên 1 thư mục luôn thì có được không ạ, vì như bên em sử dụng những địa chỉ email chuyên để nhận file từ nhiều khách hàng, hàng ngày em phải trích lưu những file đính kèm của nhiều bên gửi tới hộp mail chung đó nên việc chỉ định lấy theo từng Sender sẽ không hiệu quả. Mong anh hướng dẫn giúp.
Thử code này xem sao nhé, bởi vì bạn sử dụng tài khoản email chuyên dùng để nhận tệp đính kèm nên mình bỏ điều kiện lọc địa chỉ email, chỉ giữ lại điều kiện khoảng ngày, và tất cả những tệp đính kèm thỏa mãn yêu cầu là tệp Excel và tệp pdf đều sẽ được lưu vào chung một thư mục.
(Lưu ý: Nếu khách hàng hoặc nhiều khách hàng khác nhau gửi email gửi email chứa tệp đính kèm trùng tên thì tệp đính kèm trùng tên sẽ bị ghi đè).

Mã:
Option Explicit

Public Sub DownloadAttachments(StartDate As Date, EndDate As Date)
    Dim objMail As Outlook.MailItem
    Dim objAtt As Outlook.Attachment
    Dim objPA As Outlook.PropertyAccessor
    Dim objFSO As Object
    Dim strFolderPath As String, strDateTimeFolder As String
    Dim dteStartDate As Date, dteEndDate As Date, dteStartDateUTC As Date, dteEndDateUTC As Date
    Dim i As Long, j As Long
    Dim strFilter As String
    Dim colItems As Outlook.Items
    Dim objFolder As Outlook.Folder
    Const PR_HASATTACH As String = "http://schemas.microsoft.com/mapi/proptag/0x0E1B000B"
    dteStartDate = StartDate 'Ngay bat dau, vd: #1/1#2021#
    dteEndDate = EndDate 'Ngay ket thuc, vd: #1/1/2022#
    Set objMail = Application.CreateItem(olMailItem)
    With objMail
        Set objPA = .PropertyAccessor
        dteStartDateUTC = objPA.LocalTimeToUTC(dteStartDate)
        dteEndDateUTC = objPA.LocalTimeToUTC(dteEndDate)
        .Close olDiscard
    End With
    strFilter = "@SQL=" & Quote(PR_HASATTACH) & "=1 AND " & _
                Quote("urn:schemas:httpmail:datereceived") & " > " & Chr(39) & dteStartDateUTC & Chr(39) & " And " & Quote("urn:schemas:httpmail:datereceived") & " < " & Chr(39) & dteEndDateUTC & Chr(39)
    strFolderPath = Environ$("USERPROFILE") & "\Documents\OutlookAttachments\" 'Thu muc luu tap tin dinh kem, mac dinh: C:\<nguoidung>
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If Not objFSO.FolderExists(strFolderPath) Then objFSO.CreateFolder strFolderPath
    If Not objFSO.FolderExists(strFolderPath & Format$(Now, "dd-mm-yyyy hh.nn.ss")) Then
        strDateTimeFolder = strFolderPath & Format$(Now, "dd-mm-yyyy hh.nn.ss")
        objFSO.CreateFolder strDateTimeFolder
    Else: strDateTimeFolder = strFolderPath & Format$(Now, "dd-mm-yyyy hh.nn.ss")
    End If
    On Error Resume Next
    Set objFolder = Application.Session.PickFolder
    If Not objFolder Is Nothing Then
        Set colItems = objFolder.Items.Restrict(strFilter)
        For j = 1 To colItems.Count
            Set objMail = colItems.Item(j)
            With objMail
                For i = 1 To .Attachments.Count
                    Set objAtt = .Attachments.Item(i)
                    Select Case objFSO.GetExtensionName(objAtt.filename)
                        Case "xlsx", "xls", "xlsm", "pdf"
                            If objFSO.FileExists(strDateTimeFolder & "\" & objAtt.filename) Then
                                objFSO.DeleteFile strDateTimeFolder & "\" & objAtt.filename
                            End If
                            objAtt.SaveAsFile strDateTimeFolder & "\" & objAtt.filename
                    End Select
                Next i
            End With
        Next
        Shell "explorer """ & strFolderPath & "", vbNormalFocus
    End If
End Sub

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

hàng ngày em phải trích lưu những file đính kèm của nhiều bên gửi tới hộp mail chung đó nên việc chỉ định lấy theo từng Sender sẽ không hiệu quả.
Nếu hàng ngày phải trích lưu những tệp đính kèm như thế này thì bạn nên viết macro để Outlook tự động tải xuống tệp đính kèm mỗi khi nhận được email là được.
 
Lần chỉnh sửa cuối:
Nếu hàng ngày phải trích lưu những tệp đính kèm như thế này thì bạn nên viết macro để Outlook tự động tải xuống tệp đính kèm mỗi khi nhận được email là được.
Em cảm ơn anh, em đã chạy thử và thấy mã code của anh đã lấy được các file đính kèm gom chung vào 1 thư mục, kết quả đã đúng ạ. Chỉ lưu ý là muốn lấy dữ liệu tới ngày nào thì phải gõ EndDate sau hôm đó 1 ngày.
Hiện tại em cũng mới học VBA căn bản, giáo trình và video hướng dẫn của Excel rất nhiều, tuy nhiên về phần Outlook thì lại ít tài liệu hướng dẫn hơn. Cảm ơn anh đã chỉ dẫn, em sẽ cố gắng thêm.
 
Em cảm ơn anh, em đã chạy thử và thấy mã code của anh đã lấy được các file đính kèm gom chung vào 1 thư mục, kết quả đã đúng ạ. Chỉ lưu ý là muốn lấy dữ liệu tới ngày nào thì phải gõ EndDate sau hôm đó 1 ngày.
Hiện tại em cũng mới học VBA căn bản, giáo trình và video hướng dẫn của Excel rất nhiều, tuy nhiên về phần Outlook thì lại ít tài liệu hướng dẫn hơn. Cảm ơn anh đã chỉ dẫn, em sẽ cố gắng thêm.
Nếu bạn có thắc mắc gì về Outlook VBA, bạn có thể liên hệ với mình để được giải quyết.
 
Em cảm ơn anh, em đã chạy thử và thấy mã code của anh đã lấy được các file đính kèm gom chung vào 1 thư mục, kết quả đã đúng ạ. Chỉ lưu ý là muốn lấy dữ liệu tới ngày nào thì phải gõ EndDate sau hôm đó 1 ngày.
Hiện tại em cũng mới học VBA căn bản, giáo trình và video hướng dẫn của Excel rất nhiều, tuy nhiên về phần Outlook thì lại ít tài liệu hướng dẫn hơn. Cảm ơn anh đã chỉ dẫn, em sẽ cố gắng thêm.
À quên nữa, bổ sung thêm cái này.
Khi dùng truy vấn DASL để lọc item, Outlook cung cấp cho chúng ta một số macro thời gian được định nghĩa sẵn, ví dụ:

1669805726673.png

Như vậy, mình chỉ cần sửa macro một chút là có thể tận dụng được những macro thời gian này.

Mã:
Option Explicit

Public Enum DateTimeMacro
    Today
    Tomorrow
    Yesterday
    Next7days
    Last7days
    NextWeek
    ThisWeek
    LastWeek
    NextMonth
    ThisMonth
    LastMonth
End Enum

Public Sub DownloadAttachments(Optional UseDateTimeMacro As Boolean = False, Optional DateTimeMacro As DateTimeMacro, Optional StartDate As Date, Optional EndDate As Date)
    Dim objMail As Outlook.MailItem
    Dim objAtt As Outlook.Attachment
    Dim objPA As Outlook.PropertyAccessor
    Dim objFSO As Object
    Dim strFolderPath As String, strDateTimeFolder As String
    Dim dteStartDate As Date, dteEndDate As Date, dteStartDateUTC As Date, dteEndDateUTC As Date
    Dim i As Long, j As Long
    Dim strFilter As String
    Dim colItems As Outlook.Items
    Dim objFolder As Outlook.Folder
    Dim strDateTimeMacro As String
    Const PR_HASATTACH As String = "http://schemas.microsoft.com/mapi/proptag/0x0E1B000B"
    If UseDateTimeMacro = False Then
        dteStartDate = StartDate 'Ngay bat dau, vd: #1/1#2021#
        dteEndDate = EndDate 'Ngay ket thuc, vd: #1/1/2022#
        Set objMail = Application.CreateItem(olMailItem)
        With objMail
            Set objPA = .PropertyAccessor
            dteStartDateUTC = objPA.LocalTimeToUTC(dteStartDate)
            dteEndDateUTC = objPA.LocalTimeToUTC(dteEndDate)
            .Close olDiscard
        End With
        strFilter = "@SQL=" & Quote(PR_HASATTACH) & "=1 AND " & _
                Quote("urn:schemas:httpmail:datereceived") & " > " & Chr(39) & dteStartDateUTC & Chr(39) & " And " & Quote("urn:schemas:httpmail:datereceived") & " < " & Chr(39) & dteEndDateUTC & Chr(39)
    Else
        Select Case DateTimeMacro
            Case Today
                strDateTimeMacro = "%today(" & Quote("urn:schemas:httpmail:datereceived") & ")%"
            Case Tomorrow
                strDateTimeMacro = "%tomorrow(" & Quote("urn:schemas:httpmail:datereceived") & ")%"
            Case Yesterday
                strDateTimeMacro = "%yesterday(" & Quote("urn:schemas:httpmail:datereceived") & ")%"
            Case Next7days
                strDateTimeMacro = "%next7days(" & Quote("urn:schemas:httpmail:datereceived") & ")%"
            Case Last7days
                strDateTimeMacro = "%last7days(" & Quote("urn:schemas:httpmail:datereceived") & ")%"
            Case NextWeek
                strDateTimeMacro = "%nextweek(" & Quote("urn:schemas:httpmail:datereceived") & ")%"
            Case ThisWeek
                strDateTimeMacro = "%thisweek(" & Quote("urn:schemas:httpmail:datereceived") & ")%"
            Case LastWeek
                strDateTimeMacro = "%lastweek(" & Quote("urn:schemas:httpmail:datereceived") & ")%"
            Case NextMonth
                strDateTimeMacro = "%nextmonth(" & Quote("urn:schemas:httpmail:datereceived") & ")%"
            Case ThisMonth
                strDateTimeMacro = "%thismonth(" & Quote("urn:schemas:httpmail:datereceived") & ")%"
            Case LastMonth
                strDateTimeMacro = "%lastmonth(" & Quote("urn:schemas:httpmail:datereceived") & ")%"
        End Select
        strFilter = "@SQL=" & strDateTimeMacro & " AND " & Quote(PR_HASATTACH) & "=1 "
    End If
    strFolderPath = Environ$("USERPROFILE") & "\Documents\OutlookAttachments\" 'Thu muc luu tap tin dinh kem, mac dinh: C:\<nguoidung>
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If Not objFSO.FolderExists(strFolderPath) Then objFSO.CreateFolder strFolderPath
    If Not objFSO.FolderExists(strFolderPath & Format$(Now, "dd-mm-yyyy hh.nn.ss")) Then
        strDateTimeFolder = strFolderPath & Format$(Now, "dd-mm-yyyy hh.nn.ss")
        objFSO.CreateFolder strDateTimeFolder
    Else: strDateTimeFolder = strFolderPath & Format$(Now, "dd-mm-yyyy hh.nn.ss")
    End If
    On Error Resume Next
    Set objFolder = Application.Session.PickFolder
    If Not objFolder Is Nothing And objFolder.DefaultItemType = olMailItem Then
        Set colItems = objFolder.Items.Restrict(strFilter)
        For j = 1 To colItems.Count
            Set objMail = colItems.Item(j)
            With objMail
                For i = 1 To .Attachments.Count
                    Set objAtt = .Attachments.Item(i)
                    Select Case objFSO.GetExtensionName(objAtt.filename)
                        Case "xlsx", "xls", "xlsm", "pdf"
                            If objFSO.FileExists(strDateTimeFolder & "\" & objAtt.filename) Then
                                objFSO.DeleteFile strDateTimeFolder & "\" & objAtt.filename
                            End If
                            objAtt.SaveAsFile strDateTimeFolder & "\" & objAtt.filename
                    End Select
                Next i
            End With
        Next
        Shell "explorer """ & strFolderPath & "", vbNormalFocus
    Else: MsgBox "You must select a folder that contains email items only.", vbExclamation, "Error: Invalid Folder"
    End If
End Sub

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

Giả sử bạn muốn tải xuống đính kèm từ những email nhận được trong ngày hôm nay:

Mã:
Private Sub SaveEmailAttachments()
    Call DownloadAttachments(UseDateTimeMacro:=True, DateTimeMacro:=Today)
End Sub

Tham khảo thêm:

Filtering Items Using a Date-time Comparison

 
Lần chỉnh sửa cuối:
Web KT
Back
Top Bottom