Outlook에서 한 번에 여러 초안을 보내는 방법은 무엇입니까?

Drafts 폴더에 여러 개의 임시 메시지가있는 경우 지금은 하나씩 보내지 않고 한 번에 보내려고합니다. Outlook에서이 작업을 어떻게 빠르고 쉽게 처리 할 수 ​​있습니까?

VBA 코드를 사용하여 Outlook에서 한 번에 모든 초안 메시지 보내기

VBA 코드를 사용하여 Outlook에서 한 번에 모든 초안 메시지 보내기

다음 VBA 코드는 Drafts 폴더에서 한 번에 모든 또는 선택한 초안 이메일을 보내는 데 도움이 될 수 있습니다. 다음과 같이하십시오.

1. 누르고 ALT + F11 키를 눌러 응용 프로그램 용 Microsoft Visual Basic 창.

2. 그런 다음 끼워 넣다 > 모듈, 아래 코드를 복사하여 열린 빈 모듈에 붙여 넣으십시오. 스크린 샷을 참조하십시오.

VBA 코드 : 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. 그런 다음 코드를 저장하고 F5 키를 눌러이 코드를 실행하면 모든 초안을 보낼지 알려주는 프롬프트 상자가 나타납니다. 가능, 스크린 샷 참조 :

4. 그리고 얼마나 많은 초안 이메일이 발송되었는지 알려주는 대화 상자가 나타납니다. 스크린 샷을 참조하십시오.

5. 그런 다음 OK 버튼, 모든 이메일 체커 폴더가 한 번에 전송됩니다. 스크린 샷 참조 :

배송 시 요청 사항:

1. 위의 코드는 Outlook의 모든 계정에서 모든 초안 이메일을 보냅니다.

2. Drafts 폴더에서 특정 이메일을 보내려면 다음 VBA 코드를 적용하십시오.

VBA 코드 : Drafts 폴더에서 선택한 이메일을 보냅니다.

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

관련 기사:

Outlook에서 개별적으로 여러 수신자에게 이메일을 보내는 방법은 무엇입니까?

Outlook을 통해 Excel에서 개인화 된 대량 이메일을 목록으로 보내는 방법은 무엇입니까?

Outlook에서 개별적으로 여러 수신자에게 일정을 보내는 방법은 무엇입니까?

Outlook에서 모르는 여러 수신자에게 이메일을 보내는 방법은 무엇입니까?

---

Outlook 용 Kutools-Outlook에 100 개의 고급 기능을 제공하고 작업을 훨씬 더 쉽게 만듭니다!

• 자동 CC / BCC 이메일을 보낼 때 규칙에 따라; 자동 전달 사용자 정의에 의한 여러 이메일; 자동 회신 교환 서버없이 더 많은 자동 기능 ...
• BCC 경고 -모두 답장하려고 할 때 메시지 표시 메일 주소가 숨은 참조 목록에있는 경우; 첨부 파일 누락시 알림및 기타 알림 기능 ...
• 메일 대화에서 모든 첨부 파일로 (전체) 회신; 많은 이메일에 답장 초 안에; 인사말 자동 추가 대답 할 때; 제목에 날짜 추가 ...
• 첨부 도구 : 모든 메일의 모든 첨부 파일 관리, 자동 분리, 모두 압축, 모두 이름 바꾸기, 모두 저장 ... 빠른 보고서, 선택한 메일 수...
• 강력한 정크 메일 관습에 의해; 중복 메일 및 연락처 제거... Outlook에서 더 스마트하고 빠르며 더 나은 작업을 수행 할 수 있습니다.

자세히보기 ... 지금 다운로드 ...