Note: The other languages of the website are Google-translated. Back to English

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, 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.
girato kutools outlook scheda kutools 1180x121
girato kutools outlook kutools plus tab 1180x121
 
Commenti (15)
Ancora nessuna valutazione. Puoi essere il primo a votare!
Questo commento è stato fatto dal moderatore sul sito
Brillante, ha funzionato a meraviglia, grazie :)
Questo commento è stato fatto dal moderatore sul sito
einfach nur perfetto. Herzlichen Dank
Questo commento è stato fatto dal moderatore sul sito
Copiato come sopra ma quando premo F5 non succede nulla
Questo commento è stato fatto dal moderatore sul sito
Ciao, Caterina,
Il codice sopra funziona bene nel mio Outlook, quale versione di Outlook usi?
Questo commento è stato fatto dal moderatore sul sito
Ho più conti di scambio. Voglio avere uno degli account che non è il mio predefinito come mittente. Dove lo inserisco nel codice? Grazie!
Questo commento è stato fatto dal moderatore sul sito
Qualcuno riceve delle e-mail inviate alla cartella eliminata in questo modo?
Questo commento è stato fatto dal moderatore sul sito
Ciao, Bill,
Vuoi inviare più email selezionate da foder cancellato?
Si prega di fornire il problema in modo più dettagliato, grazie!
Questo commento è stato fatto dal moderatore sul sito
Ciao skyyang, sto affrontando lo stesso problema. Di solito scrivo 15-20 e-mail e quindi utilizzo questo codice per inviarle tutte in una volta, ma in seguito mi rendo conto che una di quelle e-mail non viene inviata, ma viene inviata alla mia cartella "Eliminata". Anche il prompt dice il numero corretto di e-mail, ad esempio: "20 e-mail inviate", ma quando controllo, ne sarebbero state inviate solo 19, una la troverò nella cartella degli elementi eliminati. Voglio che tutte le email vengano inviate ai loro destinatari senza errori. Per favore, puoi dirmi perché questo accade. Per favore aiuto.
Questo commento è stato fatto dal moderatore sul sito
Ciao, Darewin, abbiamo aggiornato i codici sopra, per favore riprova, grazie!
Questo commento è stato fatto dal moderatore sul sito
Stesso problema: se si selezionano 4 messaggi, dopo aver inviato tre di loro ar nella cartella cestino (a causa dell'istruzione "xDraftsItems.Item(i).Delete")
Questo commento è stato fatto dal moderatore sul sito
Abbiamo utilizzato lo script per inviare tutte le bozze di e-mail contemporaneamente per un batch di e-mail di dichiarazione generate dal saggio 200. Le e-mail negli articoli inviati sembrano a posto, ma i clienti le ricevono con il corpo del testo in cinese! Qualche idea su cosa potrebbe succedere qui?
Questo commento è stato fatto dal moderatore sul sito
Puoi spiegare perché l'ultima mail (i = 1) viene ricreata in un nuovo MailItem invece che solo .Send?

Grazie.
Questo commento è stato fatto dal moderatore sul sito
Ciao, domanda veloce forse hai un'idea. Abbiamo un'applicazione esterna che salva tutte le e-mail nella cartella delle bozze. se eseguo la macro abbiamo il problema, che solo la prima mail nell'elenco viene inviata correttamente, tutte le altre mail vengono posticipate perché aggiunge virgolette ' ' all'indirizzo di posta. C'è un modo per evitarlo?
Questo commento è stato fatto dal moderatore sul sito
Questo codice invia tutte le bozze in una sottocartella denominata Strumenti di unione (ti chiede prima di inviare). Sono sicuro che voi ragazzi potete modificarlo in base alle vostre esigenze. È molto più semplice. Divertiti :)
Sub SendAllMergeToolsBozze()

Se MsgBox("Sei sicuro di voler inviare TUTTI gli elementi nella cartella delle bozze Strumenti di unione?", _
vbDomanda + vbSìNo) <> vbSì Quindi esci da Sub

Dim myNamespace As Outlook.NameSpace 'Cambia vista in Posta in arrivo per evitare errori inline
Imposta myNamespace = Application.GetNamespace("MAPI") 'Cambia vista in Posta in arrivo per evitare errori inline
Imposta Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) 'Cambia vista in Posta in arrivo per evitare errori inline

Dim fldDraft As MAPIFolder, msg As Outlook.MailItem, intCount As Integer
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).Folders("Unisci strumenti") 'Invia tutte le bozze solo nella cartella Unisci strumenti
Conteggio int = 0
Do While fldDraft.Items.count > 0
Imposta msg = fldDraft.Items(1)
msg.Invia
intCount = intCount + 1
Ciclo continuo
In caso contrario (msg non è nulla), impostare msg = Nothing
Imposta fldDraft = Niente
MsgBox intCount & "messaggi inviati", vbInformation + vbOKOnly

End Sub
Questo commento è stato fatto dal moderatore sul sito
Ciao ragazzi. Ho pensato di condividere. Ecco il mio codice per inviare tutte le bozze:
Sub SendAllDrafts() 'Di jamesmalcolmwood@gmail.com

Se MsgBox("Sei sicuro di voler inviare TUTTI gli elementi nella cartella delle bozze?", _
vbDomanda + vbSìNo) <> vbSì Quindi esci da Sub

Dim myNamespace As Outlook.NameSpace 'Cambia vista in Posta in arrivo per evitare errori inline
Imposta myNamespace = Application.GetNamespace("MAPI") 'Cambia vista in Posta in arrivo per evitare errori inline
Imposta Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) 'Cambia vista in Posta in arrivo per evitare errori inline

Dim fldDraft As MAPIFolder, msg As Outlook.MailItem, intCount As Integer
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts) 'Invia tutte le bozze nella cartella principale delle bozze. Per una sottocartella, aggiungi .Folders("nome cartella")
Conteggio int = 0
Do While fldDraft.Items.count > 0
Imposta msg = fldDraft.Items(1)
msg.Invia
intCount = intCount + 1
Ciclo continuo
In caso contrario (msg non è nulla), impostare msg = Nothing
Imposta fldDraft = Niente
MsgBox intCount & "messaggi inviati", vbInformation + vbOKOnly

End Sub
Non ci sono ancora commenti pubblicati qui
Lasciate i vostri commenti
Pubblicazione come ospite
×
Valuta questo post:
0   Personaggi
Posizioni suggerite

Seguici

Copyright © 2009 - www.extendoffice.com. | Tutti i diritti riservati. Offerto da ExtendOffice, | Mappa del sito
Microsoft e il logo Office sono marchi o marchi registrati di Microsoft Corporation negli Stati Uniti e / o in altri paesi.
Protetto da Sectigo SSL