Làm cách nào để xuất email từ nhiều thư mục / thư mục con sang excel trong Outlook?
Khi xuất một thư mục bằng thuật sĩ Nhập và Xuất trong Outlook, nó không hỗ trợ Bao gồm các thư mục con nếu bạn xuất thư mục sang tệp CSV. Tuy nhiên, sẽ khá mất thời gian và tẻ nhạt khi xuất từng thư mục sang tệp CSV rồi chuyển đổi sang sổ làm việc Excel theo cách thủ công. Ở đây, bài viết này sẽ giới thiệu một VBA để nhanh chóng xuất nhiều thư mục và thư mục con sang sổ làm việc Excel một cách dễ dàng.
Xuất nhiều email từ nhiều thư mục / thư mục con sang Excel với VBA
- Gửi email tự động với Auto CC / BCC, Tự động chuyển tiếp theo quy định; gửi Tự động trả lời (Vắng mặt) mà không cần máy chủ trao đổi...
- Nhận lời nhắc như Cảnh báo BCC khi trả lời tất cả khi bạn đang ở trong danh sách BCC và Nhắc nhở khi thiếu tệp đính kèm để quên các tệp đính kèm...
- Cải thiện hiệu quả email với Trả lời (Tất cả) kèm tệp đính kèm, Tự động thêm lời chào hoặc ngày và giờ vào chữ ký hoặc chủ đề, Trả lời nhiều emailhữu ích. Cảm ơn !
- Hợp lý hóa việc gửi email với Thu hồi email, Công cụ đính kèm (Nén tất cả, Tự động lưu tất cả...), Loại bỏ các bản saovà Báo cáo nhanhhữu ích. Cảm ơn !
Xuất nhiều email từ nhiều thư mục / thư mục con sang Excel với VBA
Vui lòng làm theo các bước dưới đây để xuất email từ nhiều thư mục hoặc thư mục con sang sổ làm việc Excel với VBA trong Outlook.
1. nhấn Khác + F11 để mở cửa sổ Microsoft Visual Basic for Applications.
2. nhấp chuột Chèn > Mô-đun, rồi dán mã VBA bên dưới vào cửa sổ Mô-đun mới.
VBA: Xuất email từ nhiều thư mục và thư mục con sang Excel
Const MACRO_NAME = "Export Outlook Folders to Excel"
Sub ExportMain()
ExportToExcel "destination_folder_path\A.xlsx", "your_email_accouny\folder\subfolder_1"
ExportToExcel "destination_folder_path\B.xlsx", "your_email_accouny\folder\subfolder_2"
MsgBox "Process complete.", vbInformation + vbOKOnly, MACRO_NAME
End Sub
Sub ExportToExcel(strFilename As String, strFolderPath As String)
Dim olkMsg As Object
Dim olkFld As Object
Dim excApp As Object
Dim excWkb As Object
Dim excWks As Object
Dim intRow As Integer
Dim intVersion As Integer
If strFilename <> "" Then
If strFolderPath <> "" Then
Set olkFld = OpenOutlookFolder(strFolderPath)
If TypeName(olkFld) <> "Nothing" Then
intVersion = GetOutlookVersion()
Set excApp = CreateObject("Excel.Application")
Set excWkb = excApp.Workbooks.Add()
Set excWks = excWkb.ActiveSheet
'Write Excel Column Headers
With excWks
.Cells(1, 1) = "Subject"
.Cells(1, 2) = "Received"
.Cells(1, 3) = "Sender"
End With
intRow = 2
For Each olkMsg In olkFld.Items
'Only export messages, not receipts or appointment requests, etc.
If olkMsg.Class = olMail Then
'Add a row for each field in the message you want to export
excWks.Cells(intRow, 1) = olkMsg.Subject
excWks.Cells(intRow, 2) = olkMsg.ReceivedTime
excWks.Cells(intRow, 3) = GetSMTPAddress(olkMsg, intVersion)
intRow = intRow + 1
End If
Next
Set olkMsg = Nothing
excWkb.SaveAs strFilename
excWkb.Close
Else
MsgBox "The folder '" & strFolderPath & "' does not exist in Outlook.", vbCritical + vbOKOnly, MACRO_NAME
End If
Else
MsgBox "The folder path was empty.", vbCritical + vbOKOnly, MACRO_NAME
End If
Else
MsgBox "The filename was empty.", vbCritical + vbOKOnly, MACRO_NAME
End If
Set olkMsg = Nothing
Set olkFld = Nothing
Set excWks = Nothing
Set excWkb = Nothing
Set excApp = Nothing
End Sub
Public Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
Dim arrFolders As Variant
Dim varFolder As Variant
Dim bolBeyondRoot As Boolean
On Error Resume Next
If strFolderPath = "" Then
Set OpenOutlookFolder = Nothing
Else
Do While Left(strFolderPath, 1) = "\"
strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
Loop
arrFolders = Split(strFolderPath, "\")
For Each varFolder In arrFolders
Select Case bolBeyondRoot
Case False
Set OpenOutlookFolder = Outlook.Session.Folders(varFolder)
bolBeyondRoot = True
Case True
Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
End Select
If Err.Number <> 0 Then
Set OpenOutlookFolder = Nothing
Exit For
End If
Next
End If
On Error GoTo 0
End Function
Function GetSMTPAddress(Item As Outlook.MailItem, intOutlookVersion As Integer) As String
Dim olkSnd As Outlook.AddressEntry
Dim olkEnt As Object
On Error Resume Next
Select Case intOutlookVersion
Case Is < 14
If Item.SenderEmailType = "EX" Then
GetSMTPAddress = SMTPEX(Item)
Else
GetSMTPAddress = Item.SenderEmailAddress
End If
Case Else
Set olkSnd = Item.Sender
If olkSnd.AddressEntryUserType = olExchangeUserAddressEntry Then
Set olkEnt = olkSnd.GetExchangeUser
GetSMTPAddress = olkEnt.PrimarySmtpAddress
Else
GetSMTPAddress = Item.SenderEmailAddress
End If
End Select
On Error GoTo 0
Set olkPrp = Nothing
Set olkSnd = Nothing
Set olkEnt = Nothing
End Function
Function GetOutlookVersion() As Integer
Dim arrVer As Variant
arrVer = Split(Outlook.Version, ".")
GetOutlookVersion = arrVer(0)
End Function
Function SMTPEX(olkMsg As Outlook.MailItem) As String
Dim olkPA As Outlook.propertyAccessor
On Error Resume Next
Set olkPA = olkMsg.propertyAccessor
SMTPEX = olkPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x5D01001E")
On Error GoTo 0
Set olkPA = Nothing
End Function
3. Vui lòng điều chỉnh mã VBA ở trên khi bạn cần.
(1) Thay thế Desti_folder_path trong đoạn mã trên với đường dẫn thư mục của thư mục đích, bạn sẽ lưu các sổ làm việc đã xuất vào, chẳng hạn như C: \ Users \ DT168 \ Documents \ TEST.
(2) Thay thế your_email_accouny \ folder \ subfolder_1 và your_email_accouny \ folder \ subfolder_2 trong mã trên bằng các đường dẫn thư mục của các thư mục con trong Outlook, chẳng hạn như \ Hộp thư đến \ A và \ Hộp thư đến \ B
4. Nhấn nút F5 phím hoặc nhấp vào chạy để chạy VBA này. Và sau đó nhấp vào OK trong hộp thoại Xuất Thư mục Outlook sang Excel xuất hiện. Xem ảnh chụp màn hình:
Và bây giờ email từ tất cả các thư mục con hoặc thư mục được chỉ định trong mã VBA ở trên được xuất và lưu vào sổ làm việc Excel.
Bài viết liên quan
Xuất email theo phạm vi ngày sang tệp Excel hoặc tệp PST trong Outlook
Xuất và in danh sách tất cả các thư mục và thư mục con trong Outlook
Công cụ năng suất văn phòng tốt nhất
Kutools cho Outlook - Hơn 100 tính năng mạnh mẽ để tăng cường Outlook của bạn
📧 Tự động hoá email: Vắng Mặt (Có sẵn cho POP và IMAP) / Lên lịch gửi email / Tự động CC/BCC theo quy định khi gửi Email / Tự động chuyển tiếp (Quy tắc nâng cao) / Tự động thêm lời chào / Tự động chia email nhiều người nhận thành các tin nhắn riêng lẻ hữu ích. Cảm ơn !
📨 Quản lý email: Dễ dàng thu hồi email / Chặn email lừa đảo theo chủ đề và những người khác / Xóa các email trùng lặp / Tìm Kiếm Nâng Cao / Hợp nhất các thư mục hữu ích. Cảm ơn !
📁 Tệp đính kèm chuyên nghiệp: Lưu hàng loạt / Tách hàng loạt / Nén hàng loạt / Tự động lưu / Tự động tách / Tự động nén hữu ích. Cảm ơn !
🌟 Giao diện ma thuật: 😊Thêm nhiều biểu tượng cảm xúc đẹp và thú vị hơn / Tăng năng suất Outlook của bạn với chế độ xem theo thẻ / Thu nhỏ Outlook thay vì đóng hữu ích. Cảm ơn !
👍 Kỳ quan chỉ bằng một cú nhấp chuột: Trả lời tất cả bằng tệp đính kèm đến / Email chống lừa đảo / 🕘Hiển thị múi giờ của người gửi hữu ích. Cảm ơn !
👩🏼🤝👩🏻 Danh bạ & Lịch: Thêm hàng loạt liên hệ từ các email đã chọn / Chia nhóm liên hệ thành các nhóm riêng lẻ / Xóa lời nhắc sinh nhật hữu ích. Cảm ơn !
Trên 100 tính năng Chờ đợi sự khám phá của bạn! Bấm vào đây để khám phá thêm.