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

Kako poslati več osnutkov hkrati v Outlooku?

Če je v mapi Osnutki več osnutkov sporočil in jih želite poslati naenkrat, ne da bi jih pošiljali posebej. Kako bi se lahko v Outlooku hitro in enostavno spopadli s tem delom?

Vsa osnutka sporočil pošljite hkrati v Outlooku s kodo VBA


Vsa osnutka sporočil pošljite hkrati v Outlooku s kodo VBA

Naslednje kode VBA vam lahko pomagajo pri pošiljanju vseh ali izbranih osnutkov e-poštnih sporočil iz mape Osnutki hkrati. Naredite to:

1. Držite tipko ALT + F11 tipke za odpiranje Microsoft Visual Basic za aplikacije okno.

2. Nato kliknite Vstavi > Moduli, kopirajte in prilepite spodnjo kodo v odprti prazen modul, glejte posnetek zaslona:

Koda VBA: V Outlooku pošljite vsa osnutka e-poštnih sporočil hkrati:

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. Nato shranite kodo in pritisnite F5 tipko za zagon te kode, se prikaže pozivno polje, ki vas opozori, če želite poslati vse osnutke, kliknite Da, glej posnetek zaslona:

4. Odprlo se bo pogovorno okno, ki vas bo opozorilo, koliko osnutkov e-poštnih sporočil je bilo poslanih, glejte posnetek zaslona:

5. In nato kliknite OK gumb, vsa e-poštna sporočila v Osnutki mapa bo poslana naenkrat, glej posnetek zaslona:

Opombe:

1. Zgornja koda bo poslala vsa osnutka e-poštnih sporočil iz vseh računov v Outlooku.

2. Če želite poslati nekatera posebna e-poštna sporočila iz mape Osnutki, uporabite naslednjo kodo VBA:

Koda VBA: Pošlji izbrano e-pošto iz mape Osnutki:

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

Sorodni članki:

Kako poslati e-pošto več prejemnikom posamezno v programu Outlook?

Kako poslati množična e-poštna sporočila na seznam iz Excela prek Outlooka?

Kako poslati koledar posameznim prejemnikom v Outlooku?

Kako poslati e-pošto več prejemnikom, ne da bi oni vedeli v programu Outlook?


Kutools za Outlook - prinaša 100 naprednih funkcij v Outlook in olajša delo!

  • Samodejno CC / BCC po pravilih pri pošiljanju e-pošte; Samodejno posredovanje naprej Več e-poštnih sporočil po meri; Samodejni odgovor brez strežnika za izmenjavo in več samodejnih funkcij ...
  • Opozorilo pred BCC - prikaži sporočilo, ko poskušate odgovoriti vsem če je vaš poštni naslov na seznamu BCC; Opomni, ko manjkajo priloge, in več opomnikov ...
  • Odgovori (vsi) z vsemi prilogami v e-poštnem pogovoru; Odgovori na veliko e-poštnih sporočil v nekaj sekundah; Samodejno dodaj pozdrav ko odgovor; Dodaj datum v zadevo ...
  • Orodja za priloge: Upravljanje vseh prilog v vseh e-poštnih sporočilih, Samodejno loči, Stisni vse, Preimenuj vse, Shrani vse ... Hitro poročilo, Štejte izbrano pošto...
  • Zmogljiva neželena e-poštna sporočila po meri; Odstranite podvojene pošte in stike... Omogočajo vam pametnejše, hitrejše in boljše delovanje v Outlooku.
strelec kutools outlook kutools zavihek 1180x121
shot kutools outlook kutools plus jeziček 1180x121
 
Komentarji (15)
Ocene še ni. Bodite prvi in ​​ocenite!
Ta komentar je moderator na spletnem mestu minimiziral
Odlično, lepo je delovalo, hvala :)
Ta komentar je moderator na spletnem mestu minimiziral
einfach nur perfekt. Herzlichen Dank
Ta komentar je moderator na spletnem mestu minimiziral
Kopirano kot zgoraj, vendar ko pritisnem F5, se ne zgodi nič
Ta komentar je moderator na spletnem mestu minimiziral
Živjo, Cathleen,
Zgornja koda dobro deluje v mojem Outlooku. Katero različico Outlooka uporabljate?
Ta komentar je moderator na spletnem mestu minimiziral
Imam več menjalnih računov. Za pošiljatelja želim imeti enega od računov, ki ni moj privzeti. Kam naj to vstavim v kodo? hvala
Ta komentar je moderator na spletnem mestu minimiziral
Je komu v tem primeru poslana e-pošta v izbrisano mapo?
Ta komentar je moderator na spletnem mestu minimiziral
Živjo, Bill,
Ali želite poslati več izbranih e-poštnih sporočil iz izbrisane mape?
Prosimo, opišite svojo težavo podrobneje, hvala!
Ta komentar je moderator na spletnem mestu minimiziral
Živjo skyyang, soočam se z isto težavo. Običajno pripravim osnutke 15–20 e-poštnih sporočil in jih nato uporabim s to kodo, da jih pošljem vsa naenkrat, vendar pozneje ugotovim, da eno od teh e-poštnih sporočil ni poslano, temveč je poslano v mojo mapo »Izbrisano«. Celo v pozivu piše pravilno število e-poštnih sporočil, npr.: '20 poslanih e-poštnih sporočil', ko pa preverim, bi jih bilo poslanih samo 19, eno pa bom našel v mapi z izbrisanimi predmeti. Želim, da so vsa e-poštna sporočila poslana prejemnikom brez napak. Mi lahko prosim poveste, zakaj se to zgodi? Prosim pomagajte.
Ta komentar je moderator na spletnem mestu minimiziral
Živjo, Darewin, posodobili smo zgornje kode, poskusite znova, hvala!
Ta komentar je moderator na spletnem mestu minimiziral
Ista težava: če izberete 4 sporočila, potem ko pošljete tri, ostanejo v mapi smetnjaka (zaradi izjave "xDraftsItems.Item(i).Delete")
Ta komentar je moderator na spletnem mestu minimiziral
Uporabili smo skript za pošiljanje vseh osnutkov e-poštnih sporočil hkrati za serijo e-poštnih sporočil z izjavami, ustvarjenih iz sage 200. E-poštna sporočila v poslanih elementih so videti v redu, vendar jih stranke prejemajo z glavnim besedilom v kitajščini! Kakšne ideje, kaj bi se lahko dogajalo tukaj?
Ta komentar je moderator na spletnem mestu minimiziral
Ali lahko pojasnite, zakaj je zadnja pošta (i = 1) ponovno ustvarjena v novem MailItem namesto samo .Send?

Hvala.
Ta komentar je moderator na spletnem mestu minimiziral
Živjo, hitro vprašanje, morda imaš idejo. Imamo zunanjo aplikacijo, ki vso pošto shrani v mapo z osnutki. če zaženem makro, imamo težavo, da je pravilno poslana samo prva pošta na seznamu, vsa druga pošta pa je odložena, ker poštnemu naslovu doda narekovaje " ". Ali obstaja način, da se temu izognem?
Ta komentar je moderator na spletnem mestu minimiziral
Ta koda pošlje vse osnutke v podmapo, imenovano Orodja za spajanje (pred pošiljanjem vas vpraša). Prepričan sem, da ga lahko uredite tako, da ustreza vašim potrebam. To je veliko bolj preprosto. uživajte :)
Sub SendAllMergeToolsDrafts()

If MsgBox("Ali ste prepričani, da želite poslati VSE elemente v mapi z osnutki orodij za spajanje?", _
vbVprašanje + vbDaNe) <> vbDa Nato zapustite Sub

Zatemni mojNamespace Kot Outlook.NameSpace 'Spremeni pogled na Prejeto, da se izogneš napaki v vrstici
Set myNamespace = Application.GetNamespace("MAPI") 'Spremeni pogled na Prejeto, da se izogneš napaki v vrstici
Nastavite Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) 'Spremeni pogled na Prejeto, da se izogneš napaki v vrstici

Dim fldDraft Kot MAPIFolder, msg Kot Outlook.MailItem, intCount Kot Integer
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).Folders("Merge Tools") 'Pošlje vse osnutke samo v mapi Merge Tools
intCount = 0
Naredi Medtem ko fldDraft.Items.count > 0
Nastavi sporočilo = fldDraft.Items(1)
msg.Send
intCount = intCount + 1
Zanka
Če ne (sporočilo ni nič), potem nastavite sporočilo = nič
Nastavite fldDraft = nič
MsgBox intCount & "poslana sporočila", vbInformation + vbOKOnly

End Sub
Ta komentar je moderator na spletnem mestu minimiziral
Zdravo družba. Mislil sem, da bi delil. Tukaj je moja koda za pošiljanje vseh osnutkov:
Sub SendAllDrafts() 'Avtor jamesmalcolmwood@gmail.com

If MsgBox("Ste prepričani, da želite poslati VSE elemente v mapi z osnutki?", _
vbVprašanje + vbDaNe) <> vbDa Nato zapustite Sub

Zatemni mojNamespace Kot Outlook.NameSpace 'Spremeni pogled na Prejeto, da se izogneš napaki v vrstici
Set myNamespace = Application.GetNamespace("MAPI") 'Spremeni pogled na Prejeto, da se izogneš napaki v vrstici
Nastavite Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) 'Spremeni pogled na Prejeto, da se izogneš napaki v vrstici

Dim fldDraft Kot MAPIFolder, msg Kot Outlook.MailItem, intCount Kot Integer
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts) 'Pošlje vse osnutke v vaši glavni mapi z osnutki. Za podmapo dodajte .Folders("ime mape")
intCount = 0
Naredi Medtem ko fldDraft.Items.count > 0
Nastavi sporočilo = fldDraft.Items(1)
msg.Send
intCount = intCount + 1
Zanka
Če ne (sporočilo ni nič), potem nastavite sporočilo = nič
Nastavite fldDraft = nič
MsgBox intCount & "poslana sporočila", vbInformation + vbOKOnly

End Sub
Tu še ni objavljenih komentarjev
Pustite vaše komentarje
Objava kot gost
×
Ocenite to objavo:
0   Znaki
Predlagane lokacije