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

Wie kann ich in Outlook mehrere Entwürfe gleichzeitig senden?

Wenn sich in Ihrem Entwurfsordner mehrere Entwurfsnachrichten befinden und Sie diese jetzt gleichzeitig senden möchten, ohne sie einzeln zu senden. Wie können Sie diesen Job in Outlook schnell und einfach erledigen?

Senden Sie alle Entwurfsnachrichten gleichzeitig in Outlook mit VBA-Code


Senden Sie alle Entwurfsnachrichten gleichzeitig in Outlook mit VBA-Code

Die folgenden VBA-Codes können Ihnen helfen, alle oder ausgewählte Entwurfs-E-Mails gleichzeitig aus dem Ordner "Entwürfe" zu senden. Gehen Sie dazu folgendermaßen vor:

1. Halten Sie die Taste gedrückt ALT + F11 Schlüssel zum Öffnen der Microsoft Visual Basic für Applikationen Fenster.

2. Dann klick Insert > Modul, kopieren Sie den folgenden Code und fügen Sie ihn in das geöffnete leere Modul ein, siehe Screenshot:

VBA-Code: Senden Sie alle E-Mail-Entwürfe gleichzeitig 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. Speichern Sie dann den Code und drücken Sie F5 Wenn Sie den Schlüssel zum Ausführen dieses Codes eingeben, wird ein Eingabeaufforderungsfeld angezeigt, das Sie daran erinnert, ob Sie alle Entwürfe gesendet haben. Klicken Sie auf Ja, siehe Screenshot:

4. Ein Dialogfeld wird angezeigt, in dem Sie daran erinnert werden, wie viele E-Mail-Entwürfe gesendet wurden (siehe Abbildung):

5. Und dann klick OK Schaltfläche, alle E-Mails in der Dame Ordner wird sofort gesendet, siehe Screenshot:

Hinweise:

1. Mit dem obigen Code werden alle E-Mail-Entwürfe von allen Konten in Ihrem Outlook gesendet.

2. Wenn Sie nur bestimmte E-Mails aus dem Ordner "Entwürfe" senden möchten, wenden Sie den folgenden VBA-Code an:

VBA-Code: Senden Sie ausgewählte E-Mails aus dem Ordner "Entwürfe":

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

Weitere Artikel:

Wie sende ich eine E-Mail in Outlook einzeln an mehrere Empfänger?

Wie sende ich personalisierte Massen-E-Mails aus Excel über Outlook an eine Liste?

Wie sende ich einen Kalender in Outlook einzeln an mehrere Empfänger?

Wie sende ich E-Mails an mehrere Empfänger, ohne dass diese dies in Outlook wissen?


Kutools für Outlook - Bringt 100 erweiterte Funktionen in Outlook und erleichtert die Arbeit erheblich!

  • Auto CC / BCC nach Regeln beim Versenden von E-Mails; Automatische Weiterleitung Mehrere E-Mails nach Kundenwunsch; Automatische Antwort ohne Exchange Server und mehr automatische Funktionen ...
  • BCC-Warnung - Nachricht anzeigen, wenn Sie versuchen, alle zu beantworten wenn Ihre E-Mail-Adresse in der BCC-Liste enthalten ist; Bei fehlenden Anhängen erinnernund weitere Erinnerungsfunktionen ...
  • Antwort (Alle) mit allen Anhängen in der E-Mail-Konversation; Viele E-Mails beantworten in Sekunden; Begrüßung automatisch hinzufügen bei der Antwort; Datum zum Betreff hinzufügen ...
  • Anhang Tools: Alle Anhänge in allen Mails verwalten, Automatische Trennung, Alle komprimieren, Alle umbenennen, Alle speichern ... Schnellbericht, Ausgewählte Mails zählen...
  • Leistungsstarke Junk-E-Mails nach Brauch; Entfernen Sie doppelte E-Mails und Kontakte... Ermöglichen Sie es Ihnen, in Outlook intelligenter, schneller und besser zu arbeiten.
Schuss Kutools Outlook Kutools Tab 1180x121
Schuss Kutools Outlook Kutools plus Tab 1180x121
 
Kommentare (15)
Noch keine Bewertungen. Bewerten Sie als Erster!
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Genial, hat wunderbar funktioniert, danke :)
Dieser Kommentar wurde vom Moderator auf der Website minimiert
einfach nur perfekt. Herzlichen Dank
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Wie oben kopiert, aber wenn ich F5 drücke, passiert nichts
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Kathleen,
Der obige Code funktioniert in meinem Outlook einwandfrei, welche Outlook-Version verwenden Sie?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Ich habe mehrere Exchange-Konten. Ich möchte eines der Konten, das nicht mein Standardkonto ist, als Absender verwenden. Wo würde ich das in den Code einfügen? Vielen Dank!
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hat jemand einige E-Mails an den gelöschten Ordner gesendet, wenn er dies tut?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Bill,
Möchten Sie mehrere ausgewählte E-Mails von gelöschten Ordnern senden?
Bitte geben Sie Ihr Problem genauer an, danke!
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Skyyang, ich stehe vor dem gleichen Problem. Ich entwerfe normalerweise 15-20 E-Mails und verwende dann diesen Code, um sie alle auf einmal zu senden, aber später stelle ich fest, dass eine dieser E-Mails nicht gesendet wird, sondern in meinen Ordner „Gelöscht“ verschoben wird. Sogar die Eingabeaufforderung sagt die korrekte Anzahl von E-Mails, z. B.: "20 E-Mails gesendet", aber wenn ich nachsehe, wären nur 19 gesendet worden, eine finde ich in meinem Ordner "Gelöschte Elemente". Ich möchte, dass alle E-Mails fehlerfrei an ihre Empfänger gesendet werden. Können Sie mir bitte sagen, warum dies geschieht. Bitte helfen Sie.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, Darewin, wir haben die obigen Codes aktualisiert, bitte versuchen Sie es erneut, danke!
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Gleiches Problem: Wenn Sie 4 Nachrichten auswählen, werden drei davon nach dem Senden im Papierkorbordner abgelegt (wegen der Anweisung "xDraftsItems.Item(i).Delete").
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Wir haben das Skript verwendet, um alle E-Mail-Entwürfe auf einmal für einen Stapel von Statement-E-Mails zu senden, die von Sage 200 generiert wurden. Die E-Mails in den gesendeten Elementen sehen gut aus, aber die Kunden erhalten sie mit dem Haupttext auf Chinesisch! Irgendwelche Ideen, was hier passieren könnte?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Können Sie erklären, warum die letzte Mail (i = 1) in einem neuen MailItem neu erstellt wird, anstatt nur .Send?

Vielen Dank.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, kurze Frage vielleicht habt ihr eine Idee. Wir haben eine externe Anwendung, die alle E-Mails im Entwurfsordner speichert. Wenn ich das Makro starte, haben wir das Problem, dass nur die erste Mail in der Liste korrekt gesendet wird, alle anderen Mails werden zurückgestellt, weil es Anführungszeichen ' ' an die Mailadresse anfügt. Gibt es eine Möglichkeit, dies zu vermeiden?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Dieser Code sendet alle Entwürfe in einen Unterordner namens Merge Tools (er fragt Sie vor dem Senden). Ich bin mir sicher, dass ihr es an eure Bedürfnisse anpassen könnt. Es ist viel einfacher. Genießen :)
Sub SendAllMergeToolsDrafts()

If MsgBox("Sind Sie sicher, dass Sie ALLE Elemente in Ihrem Entwurfsordner für Merge Tools senden möchten?", _
vbQuestion + vbYesNo) <> vbYes Then Exit Sub

Dim myNamespace As Outlook.NameSpace 'Ansicht in Posteingang ändern, um Inline-Fehler zu vermeiden
Set myNamespace = Application.GetNamespace("MAPI") 'Ansicht auf Posteingang ändern, um Inline-Fehler zu vermeiden
Legen Sie Application.ActiveExplorer.CurrentFolder = _ fest
myNamespace.GetDefaultFolder(olFolderInbox) 'Ändern Sie die Ansicht zu Posteingang, um Inline-Fehler zu vermeiden

Dim fldDraft als MAPIFolder, msg als Outlook.MailItem, intCount als Integer
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).Folders("Merge Tools") 'Sendet nur alle Entwürfe im Ordner "Merge Tools".
intCount = 0
Do While fldDraft.Items.count > 0
Setze msg = fldDraft.Items(1)
msg.Send
intCount = intCount + 1
Loop
Wenn nicht (msg ist nichts), dann setze msg = nichts
Legen Sie fldDraft = nichts fest
MsgBox intCount & "messages sent", vbInformation + vbOKOnly

End Sub
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Leute. Dachte ich teile. Hier ist mein Code zum Senden aller Entwürfe:
Sub SendAllDrafts() 'Von jamesmalcolmwood@gmail.com

If MsgBox("Sind Sie sicher, dass Sie ALLE Elemente in Ihrem Entwurfsordner senden möchten?", _
vbQuestion + vbYesNo) <> vbYes Then Exit Sub

Dim myNamespace As Outlook.NameSpace 'Ansicht in Posteingang ändern, um Inline-Fehler zu vermeiden
Set myNamespace = Application.GetNamespace("MAPI") 'Ansicht auf Posteingang ändern, um Inline-Fehler zu vermeiden
Legen Sie Application.ActiveExplorer.CurrentFolder = _ fest
myNamespace.GetDefaultFolder(olFolderInbox) 'Ändern Sie die Ansicht zu Posteingang, um Inline-Fehler zu vermeiden

Dim fldDraft als MAPIFolder, msg als Outlook.MailItem, intCount als Integer
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts) 'Sendet alle Entwürfe in Ihrem Hauptordner für Entwürfe. Fügen Sie für einen Unterordner .Folders("Ordnername") hinzu.
intCount = 0
Do While fldDraft.Items.count > 0
Setze msg = fldDraft.Items(1)
msg.Send
intCount = intCount + 1
Loop
Wenn nicht (msg ist nichts), dann setze msg = nichts
Legen Sie fldDraft = nichts fest
MsgBox intCount & "messages sent", vbInformation + vbOKOnly

End Sub
Es sind noch keine Kommentare vorhanden
Hinterlassen Sie Ihre Kommentare
Als Gast posten
×
Bewerte diese Nachricht:
0   Figuren
Vorgeschlagene Standorte

Folgen Sie uns

Copyright © 2009 - www.extendoffice.com. | Alle Rechte vorbehalten. Unterstützt von ExtendOffice. | Sitemap
Microsoft und das Office-Logo sind Marken oder eingetragene Marken der Microsoft Corporation in den USA und / oder anderen Ländern.
Geschützt durch Sectigo SSL