Come inviare più bozze contemporaneamente in Outlook?
Se sono presenti più bozze di messaggi nella cartella Bozze e ora, si desidera inviarli contemporaneamente senza inviarli uno per uno. Come hai potuto affrontare questo lavoro in modo rapido e semplice in Outlook?
Invia tutte le bozze di messaggi contemporaneamente in Outlook con il codice VBA
Invia tutte le bozze di messaggi contemporaneamente in Outlook con il codice VBA
I seguenti codici VBA possono aiutarti a inviare tutte le email bozze o selezionate dalla cartella Bozze contemporaneamente, per favore fai come segue:
1. Tieni premuto il ALT + F11 chiavi per aprire il Microsoft Visual Basic, Applications Edition finestra.
2. Quindi fare clic inserire > Modulo, copia e incolla sotto il codice nel modulo vuoto aperto, vedi screenshot:
Codice VBA: invia tutte le bozze di e-mail contemporaneamente in 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. Quindi salvare il codice e premere F5 tasto per eseguire questo codice, verrà visualizzata una finestra di messaggio per ricordarti se inviare tutte le bozze, fare clic su Sì, vedi screenshot:
4. E verrà visualizzata una finestra di dialogo per ricordarti quante bozze di email sono state inviate, vedi screenshot:
5. E poi clicca OK pulsante, tutte le email nel file Abbozzo la cartella verrà inviata contemporaneamente, vedi screenshot:
Note:
1. Il codice sopra invierà tutte le bozze di email da tutti gli account in Outlook.
2. Se desideri inviare solo email specifiche dalla cartella Bozze, applica il seguente codice VBA:
Codice VBA: invia email selezionate dalla cartella Bozze:
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
Articoli Correlati:
Come inviare un'e-mail a più destinatari individualmente in Outlook?
Come inviare e-mail di massa personalizzate a un elenco da Excel tramite Outlook?
Come inviare un calendario a più destinatari individualmente in Outlook?
Come inviare e-mail a più destinatari senza che loro lo sappiano in Outlook?
Kutools for Outlook: porta 100 funzionalità avanzate in Outlook e semplifica notevolmente il lavoro!
- Auto CC / BCC dalle regole durante l'invio di e-mail; Avanzamento automatico Email multiple personalizzate; Risposta automatica senza server di scambio e più funzioni automatiche ...
- Avviso BCC - mostra il messaggio quando provi a rispondere a tutti se il tuo indirizzo e-mail è nell'elenco BCC; Ricorda quando mancano allegatie altre funzioni di promemoria ...
- Rispondi (tutti) con tutti gli allegati nella conversazione di posta; Rispondi a molte email in secondi; Aggiunta automatica di saluto quando rispondi; Aggiungi la data all'oggetto ...
- Strumenti per gli allegati: gestisci tutti gli allegati in tutti i messaggi, Scollegamento automatico, Comprimi tutto, Rinomina tutto, Salva tutto... Rapporto rapido, Conta le email selezionate...
- E-mail spazzatura potenti per abitudine; Rimuovi messaggi e contatti duplicati... Consentono di fare in modo più intelligente, veloce e migliore in Outlook.
