Làm cách nào để gửi nhiều bản nháp cùng một lúc trong Outlook?
Nếu có nhiều thư nháp trong thư mục Thư nháp của bạn và bây giờ, bạn muốn gửi chúng cùng một lúc mà không cần gửi từng thư một. Làm cách nào bạn có thể giải quyết công việc này một cách nhanh chóng và dễ dàng trong Outlook?
Gửi tất cả thư nháp cùng một lúc trong Outlook với mã VBA
Gửi tất cả thư nháp cùng một lúc trong Outlook với mã VBA
Các mã VBA sau có thể giúp bạn gửi tất cả hoặc các email nháp đã chọn từ thư mục Thư nháp cùng một lúc, vui lòng thực hiện như sau:
1. Giữ ALT + F11 phím để mở Microsoft Visual Basic cho các ứng dụng cửa sổ.
2. Sau đó nhấn vào Chèn > Mô-đun, sao chép và dán mã bên dưới vào mô-đun trống đã mở, xem ảnh chụp màn hình:
Mã VBA: Gửi tất cả các email nháp cùng một lúc trong Outlook:
Sub SendAllDraftEmails()
Dim xAccount As Account
Dim xDraftFld As Folder
Dim xItemCount As Integer
Dim xCount As Integer
Dim xDraftsItems As Outlook.Items
Dim xPromptStr As String
Dim xYesOrNo As Integer
Dim i As Long
Dim xCurFld As Folder
Dim xTmpFld As Folder
On Error Resume Next
xItemCount = 0
xCount = 0
Set xTmpFld = Nothing
Set xCurFld = Application.ActiveExplorer.CurrentFolder
For Each xAccount In Outlook.Application.Session.Accounts
Set xDraftFld = xAccount.DeliveryStore.GetDefaultFolder(olFolderDrafts)
xItemCount = xItemCount + xDraftFld.Items.Count
If xDraftFld.EntryID = xCurFld.EntryID Then
Set xTmpFld = xCurFld.Parent
End If
Next xAccount
Set xDraftFld = Nothing
If xItemCount > 0 Then
xPromptStr = "Are you sure to send out all the drafts?"
xYesOrNo = MsgBox(xPromptStr, vbQuestion + vbYesNo, "Kutools for Outlook")
If xYesOrNo = vbYes Then
If Not xTmpFld Is Nothing Then
Set Application.ActiveExplorer.CurrentFolder = xTmpFld
End If
VBA.DoEvents
For Each xAccount In Outlook.Application.Session.Accounts
Set xDraftFld = xAccount.DeliveryStore.GetDefaultFolder(olFolderDrafts)
Set xDraftsItems = xDraftFld.Items
For i = xDraftsItems.Count To 1 Step -1
If xDraftsItems.Item(i).Recipients.Count <> 0 Then
xDraftsItems.Item(i).sEnd
xCount = xCount + 1
End If
Next
Next xAccount
VBA.DoEvents
Set Application.ActiveExplorer.CurrentFolder = xCurFld
MsgBox "Successfully sent " & xCount & " messages", vbInformation, "Kutools for Outlook"
End If
Else
MsgBox "No Drafts!", vbInformation + vbOKOnly, "Kutools for Outlook"
End If
End Sub
3. Sau đó lưu mã và nhấn F5 để chạy mã này, một hộp nhắc sẽ bật lên để nhắc bạn nếu gửi tất cả các bản nháp, hãy nhấp vào Có, xem ảnh chụp màn hình:
4. Và một hộp thoại sẽ bật ra để nhắc bạn có bao nhiêu email nháp đã được gửi đi, hãy xem ảnh chụp màn hình:
5. Và sau đó nhấp vào OK , tất cả các email trong Nháp thư mục sẽ được gửi cùng một lúc, xem ảnh chụp màn hình:
Ghi chú:
1. Đoạn mã trên sẽ gửi tất cả các email nháp từ tất cả các tài khoản trong Outlook của bạn.
2. Nếu bạn chỉ muốn gửi một số email cụ thể từ thư mục Thư nháp, vui lòng áp dụng mã VBA sau:
Mã VBA: Gửi các email đã chọn từ thư mục Thư nháp:
Sub SendSelectedDraftEmails()
Dim xSelection As Selection
Dim xPromptStr As String
Dim xYesOrNo As Integer
Dim i As Long
Dim xAccount As Account
Dim xCurFld As Folder
Dim xDraftsFld As Folder
Dim xTmpFld As Folder
Dim xArr() As String
Dim xCount As Integer
Dim xMail As MailItem
On Error Resume Next
xCount = 0
Set xTmpFld = Nothing
Set xCurFld = Application.ActiveExplorer.CurrentFolder
For Each xAccount In Outlook.Application.Session.Accounts
Set xDraftsFld = xAccount.DeliveryStore.GetDefaultFolder(olFolderDrafts)
If xDraftsFld.EntryID = xCurFld.EntryID Then
Set xTmpFld = xCurFld.Parent
End If
Next xAccount
If xTmpFld Is Nothing Then
MsgBox "The current folder is not a draft folder", vbInformation, "Kutools for Outlook"
Exit Sub
End If
Set xSelection = Outlook.Application.ActiveExplorer.Selection
If xSelection.Count > 0 Then
xPromptStr = "Are you sure to send out the selected " & xSelection.Count & " draft item(s)?"
xYesOrNo = MsgBox(xPromptStr, vbQuestion + vbYesNo, "Kutools for Outlook")
If xYesOrNo = vbYes Then
ReDim xArr(xSelection.Count - 1)
For i = 1 To xSelection.Count
xArr(i - 1) = xSelection.Item(i).EntryID
Next
Set Application.ActiveExplorer.CurrentFolder = xTmpFld
VBA.DoEvents
For i = 0 To UBound(xArr)
Set xMail = Application.Session.GetItemFromID(xArr(i))
If xMail.Recipients.Count <> 0 Then
xMail.sEnd
xCount = xCount + 1
End If
Next
VBA.DoEvents
Set Application.ActiveExplorer.CurrentFolder = xCurFld
MsgBox "Successfully sent " & xCount & " messages", vbInformation, "Kutools for Outlook"
End If
Else
MsgBox "No items selected!", vbInformation, "Kutools for Outlook"
End If
End Sub
Bài viết liên quan:
Làm thế nào để gửi một email đến nhiều người nhận riêng lẻ trong Outlook?
Làm thế nào để gửi email hàng loạt được cá nhân hóa đến một danh sách từ Excel qua Outlook?
Làm thế nào để gửi một lịch đến nhiều người nhận riêng lẻ trong Outlook?
Làm thế nào để gửi email đến nhiều người nhận mà họ không biết trong Outlook?
Kutools cho Outlook - Cung cấp 100 Tính năng Nâng cao cho Outlook và Làm cho Công việc Dễ dàng hơn Nhiều!
- Auto CC / BCC bởi các quy tắc khi gửi email; Tự động chuyển tiếp Nhiều Email theo tùy chỉnh; Tự động trả lời không có máy chủ trao đổi và các tính năng tự động khác ...
- Cảnh báo BCC - hiển thị tin nhắn khi bạn cố gắng trả lời tất cả nếu địa chỉ thư của bạn có trong danh sách BCC; Nhắc nhở khi thiếu tệp đính kèmvà các tính năng nhắc nhở khác ...
- Trả lời (Tất cả) Với Tất cả Tệp đính kèm trong cuộc trò chuyện qua thư; Trả lời nhiều email trong vài giây; Tự động thêm lời chào khi trả lời; Thêm Ngày vào chủ đề ...
- Công cụ Tệp đính kèm: Quản lý Tất cả Tệp đính kèm trong Tất cả Thư, Tự động tách, Nén tất cả, Đổi tên tất cả, Lưu tất cả ... Báo cáo nhanh, Đếm thư đã chọnhữu ích. Cảm ơn !
- Email rác mạnh mẽ Theo phong tục; Xóa thư và liên hệ trùng lặphữu ích. Cảm ơn ! Cho phép bạn làm việc thông minh hơn, nhanh hơn và tốt hơn trong Outlook.
