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

Cum să trimiteți mai multe schițe simultan în Outlook?

Dacă există mai multe mesaje nefinalizate în folderul Ciorne și acum, doriți să le trimiteți simultan fără a trimite unul câte unul. Cum ați putea să faceți acest lucru rapid și ușor în Outlook?

Trimiteți toate mesajele nefinalizate simultan în Outlook cu cod VBA


Trimiteți toate mesajele nefinalizate simultan în Outlook cu cod VBA

Următoarele coduri VBA vă pot ajuta să trimiteți toate mesajele de e-mail selectate sau selectate din folderul Ciorne deodată, vă rugăm să procedați astfel:

1. Țineți apăsat butonul ALT + F11 tastele pentru a deschide Microsoft Visual Basic pentru aplicații fereastră.

2. Apoi apasa Insera > Module, copiați și lipiți codul de mai jos în modulul gol deschis, vedeți captura de ecran:

Cod VBA: trimiteți toate mesajele de poștă electronică simultan în 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. Apoi salvați codul și apăsați F5 pentru a rula acest cod, va apărea o casetă de prompt pentru a vă reaminti dacă trimiteți toate schițele, faceți clic pe Da, vezi captura de ecran:

4. Și o fereastră de dialog va apărea pentru a vă reaminti câte mesaje e-mail au fost trimise, consultați captura de ecran:

5. Apoi faceți clic pe OK , toate e-mailurile din Schițe dosarul va fi trimis imediat, vezi captura de ecran:

note:

1. Codul de mai sus va trimite toate proiectele de e-mail din toate conturile din Outlook.

2. Dacă doriți doar să trimiteți câteva e-mailuri specifice din folderul Ciorne, aplicați următorul cod VBA:

Cod VBA: trimiteți e-mailurile selectate din folderul Ciorne:

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

Articole pe aceeaşi temă:

Cum să trimiteți un e-mail către mai mulți destinatari individual în Outlook?

Cum să trimiteți mesaje de e-mail personalizate către o listă din Excel prin Outlook?

Cum să trimiteți un calendar către mai mulți destinatari individual în Outlook?

Cum să trimiteți e-mail către mai mulți destinatari fără ca aceștia să știe în Outlook?


Kutools pentru Outlook - aduce 100 de caracteristici avansate în Outlook și face munca mult mai ușoară!

  • Auto CC / BCC prin reguli la trimiterea e-mailului; Auto înainte Mai multe e-mailuri personalizate; Răspuns automat fără server de schimb și mai multe funcții automate ...
  • Avertisment BCC - afișați mesajul când încercați să răspundeți la toate dacă adresa dvs. de e-mail se află în lista BCC; Amintiți-vă când lipsesc atașamentele, și mai multe caracteristici de reamintire ...
  • Răspundeți (Toate) Cu toate atașamentele din conversația prin e-mail; Răspunde la multe e-mailuri în secunde; Adăugare automată felicitare când răspundeți; Adăugați o dată în subiect ...
  • Instrumente de atașament: gestionați toate atașamentele din toate e-mailurile, Detașare automată, Comprimă toate, Redenumiți toate, Salvați toate ... Raport rapid, Numărați mesajele selectate...
  • E-mailuri nedorite puternice după obicei; Eliminați e-mailurile și persoanele de contact duplicate... Vă permit să faceți mai inteligent, mai rapid și mai bine în Outlook.
shot kutools outlook kutools fila 1180x121
shot kutools outlook kutools plus fila 1180x121
 
Comentarii (15)
Încă nu există evaluări. Fii primul care evaluează!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Genial, a funcționat un farmec, mulțumesc :)
Acest comentariu a fost redus la minimum de moderatorul de pe site
einfach nur perfect. Herzlichen Dank
Acest comentariu a fost redus la minimum de moderatorul de pe site
Copiat ca mai sus, dar când apăs pe F5 nu se întâmplă nimic
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, Cathleen,
Codul de mai sus funcționează bine în Outlook-ul meu, ce versiune de Outlook folosiți?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Am mai multe conturi de schimb valutar. Vreau să am unul dintre conturile care nu este implicit pentru a fi expeditorul. Unde aș introduce asta în cod? Mulțumiri!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Primește cineva e-mailuri trimise în folderul șters care face asta?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, Bill,
Doriți să trimiteți mai multe e-mailuri selectate din foderul șters?
Vă rugăm să dați problema mai detaliată, mulțumesc!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună Skyyang, Mă confrunt cu aceeași problemă. De obicei, redactez 15-20 de e-mailuri și apoi folosesc acest cod pentru a le trimite pe toate odată, dar mai târziu îmi dau seama că unul dintre acele e-mailuri nu este trimis, ci mai degrabă sunt trimise în folderul meu „Șters”. Chiar și promptul spune numărul corect de e-mailuri, de exemplu: „20 de e-mailuri trimise”, dar când verific, ar fi fost trimise doar 19, unul îl voi găsi în dosarul meu cu articole șterse. Doresc ca toate e-mailurile să fie trimise destinatarilor lor fără erori. Vă rog să-mi spuneți de ce se întâmplă asta. Te rog ajuta-ma.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, Darewin, Am actualizat codurile de mai sus, vă rugăm să încercați din nou, vă mulțumesc!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Aceeași problemă: dacă selectați 4 mesaje, după ce ați trimis trei dintre ele sunt în dosarul de gunoi (din cauza instrucțiunii „xDraftsItems.Item(i).Delete”)
Acest comentariu a fost redus la minimum de moderatorul de pe site
Am folosit scriptul pentru a trimite toate e-mailurile nefinalizate simultan pentru un lot de e-mailuri de extras generate de sage 200. E-mailurile din articolele trimise arată bine, dar clienții le primesc cu textul în chineză! Ai idee ce s-ar putea întâmpla aici?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Puteți explica de ce ultimul e-mail (i = 1) este recreat într-un nou MailItem în loc de doar .Send?

Multumesc.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, întrebare rapidă, poate aveți o idee. Avem o aplicație externă care salvează toate e-mailurile în folderul de ciorne. dacă rulez macro-ul, avem problema, că doar primul e-mail din listă este trimis corect, toate celelalte e-mailuri sunt amânate deoarece adaugă ghilimele „ ” la adresa de e-mail. Există vreo modalitate de a evita acest lucru?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Acest cod trimite toate schițele într-un subdosar numit Instrumente de îmbinare (vă întreabă înainte de a trimite). Sunt sigur că îl puteți edita în funcție de nevoile dvs. Este mult mai simplu. Bucura-te :)
Sub SendAllMergeToolsDrafts()

Dacă MsgBox(„Sunteți sigur că doriți să trimiteți TOATE articolele din dosarul de schițe Instrumente de îmbinare?”, _
vbQuestion + vbYesNo) <> vbYes Apoi Ieșiți din sub

Dim myNamspace As Outlook.NameSpace „Schimbați vizualizarea în Inbox pentru a evita eroarea inline
Setați myNamespace = Application.GetNamespace("MAPI") „Schimbați vizualizarea în Inbox pentru a evita eroarea inline
Setați Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) „Schimbați vizualizarea în Inbox pentru a evita eroarea inline

Dim fldDraft As MAPIFolder, msg As Outlook.MailItem, intCount As Integer
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).Folders("Merge Tools") „Trimite toate schițele numai în folderul Merge Tools
intCount = 0
Efectuați în timp ce fldDraft.Items.count > 0
Set msg = fldDraft.Items(1)
msg.Send
intCount = intCount + 1
Buclă
If Not (msg Is Nothing) Atunci Setați msg = Nimic
Set fldDraft = Nimic
MsgBox intCount & „mesaje trimise”, vbInformation + vbOKOnly

End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut baieti. M-am gândit să împărtășesc. Iată codul meu pentru trimiterea tuturor schițelor:
Sub SendAllDrafts() „De la jamesmalcolmwood@gmail.com

Dacă MsgBox(„Sunteți sigur că doriți să trimiteți TOATE articolele din dosarul de schițe?”, _
vbQuestion + vbYesNo) <> vbYes Apoi Ieșiți din sub

Dim myNamspace As Outlook.NameSpace „Schimbați vizualizarea în Inbox pentru a evita eroarea inline
Setați myNamespace = Application.GetNamespace("MAPI") „Schimbați vizualizarea în Inbox pentru a evita eroarea inline
Setați Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) „Schimbați vizualizarea în Inbox pentru a evita eroarea inline

Dim fldDraft As MAPIFolder, msg As Outlook.MailItem, intCount As Integer
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts) „Trimite toate schițele din dosarul principal de schițe. Pentru un subdosar, adăugați .Folders(„numele folderului”)
intCount = 0
Efectuați în timp ce fldDraft.Items.count > 0
Set msg = fldDraft.Items(1)
msg.Send
intCount = intCount + 1
Buclă
If Not (msg Is Nothing) Atunci Setați msg = Nimic
Set fldDraft = Nimic
MsgBox intCount & „mesaje trimise”, vbInformation + vbOKOnly

End Sub
Nu există comentarii postate aici încă
Lăsa comentarii
Postare ca invitat
×
Evaluează această postare:
0   Caractere
Locații sugerate

Urmărește-ne

Copyright © 2009 - www.extendoffice.com. | Toate drepturile rezervate. Cu sprijinul ExtendOffice. | Harta site-ului
Microsoft și sigla Office sunt mărci comerciale sau mărci comerciale înregistrate ale Microsoft Corporation în Statele Unite și / sau în alte țări.
Protejat de Sectigo SSL