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

Sut i anfon drafftiau lluosog ar unwaith yn Outlook?

Os oes sawl neges ddrafft yn eich ffolder Drafftiau, ac yn awr, rydych chi am eu hanfon ar unwaith heb anfon fesul un. Sut allech chi ddelio â'r swydd hon yn gyflym ac yn hawdd yn Outlook?

Anfonwch yr holl negeseuon drafft ar unwaith yn Outlook gyda chod VBA


Anfonwch yr holl negeseuon drafft ar unwaith yn Outlook gyda chod VBA

Gall y codau VBA canlynol eich helpu i anfon yr holl negeseuon e-bost drafft neu rai dethol o'r ffolder Drafftiau ar unwaith, gwnewch fel hyn:

1. Daliwch i lawr y ALT + F11 allweddi i agor y Microsoft Visual Basic ar gyfer Ceisiadau ffenestr.

2. Yna cliciwch Mewnosod > Modiwlau, copïo a gludo islaw'r cod i'r modiwl gwag agored, gweler y screenshot:

Cod VBA: Anfonwch bob e-bost drafft ar unwaith yn 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. Yna arbedwch y cod, a gwasgwch F5 yn allweddol i redeg y cod hwn, bydd blwch prydlon yn ymddangos i'ch atgoffa os anfonwch yr holl ddrafftiau, cliciwch Oes, gweler y screenshot:

4. A bydd blwch deialog yn popio allan i'ch atgoffa faint o negeseuon e-bost drafft sydd wedi'u hanfon, gweler y screenshot:

5. Ac yna cliciwch OK botwm, yr holl e-byst yn y Drafftiau anfonir y ffolder ar unwaith, gweler y screenshot:

Nodiadau:

1. Bydd y cod uchod yn anfon pob e-bost drafft o'r holl gyfrifon yn eich Camre.

2. Os ydych chi am anfon rhai negeseuon e-bost penodol o'r ffolder Drafftiau, defnyddiwch y cod VBA canlynol:

Cod VBA: Anfonwch e-byst dethol o'r ffolder Drafftiau:

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

Erthyglau cysylltiedig:

Sut I Anfon E-bost at Dderbynwyr Lluosog Yn Unig Mewn Rhagolwg?

Sut I Anfon E-byst Torfol Personol I Restr O Excel Trwy Rhagolwg?

Sut I Anfon Calendr at Dderbynwyr Lluosog Yn Unig Mewn Rhagolwg?

Sut I Anfon E-bost at Dderbynwyr Lluosog Heb Eu Gwybod Mewn Rhagolwg?


Kutools for Outlook - Yn Dod â 100 o Nodweddion Uwch i'w Rhagweld, a Gwneud Gwaith yn Haws Osgach!

  • Auto CC / BCC yn ôl rheolau wrth anfon e-bost; Auto Ymlaen E-byst Lluosog yn ôl arfer; Ymateb Auto heb weinydd cyfnewid, a nodweddion mwy awtomatig ...
  • Rhybudd BCC - dangoswch neges pan geisiwch ateb popeth os yw'ch cyfeiriad post yn rhestr BCC; Atgoffwch Wrth Ymlyniadau ar Goll, a mwy o nodweddion atgoffa ...
  • Ymateb (Pawb) Gyda'r Holl Atodiadau yn y sgwrs bost; Ateb Llawer o E-byst mewn eiliadau; Auto Ychwanegu Cyfarchiad wrth ateb; Ychwanegu Dyddiad i'r pwnc ...
  • Offer Ymlyniad: Rheoli Pob Atodiad ym mhob Post, Datgysylltiad Auto, Cywasgu Pawb, Ail-enwi Pawb, Arbed Pawb ... Adroddiad Cyflym, Cyfrif Postiau Dethol...
  • E-byst Sothach Pwerus yn ôl arfer; Tynnwch y Post a Chysylltiadau Dyblyg... Yn eich galluogi i wneud yn ddoethach, yn gyflymach ac yn well yn Outlook.
tab kutools rhagweld kutools tab 1180x121
kutools rhagweld rhagolygon kutools ynghyd â thab 1180x121
 
sylwadau (15)
Dim sgôr eto. Byddwch y cyntaf i sgorio!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Gwych, gweithiodd swyn, diolch :)
Lleihawyd y sylw hwn gan y safonwr ar y wefan
einfach nur perfekt. Herzlichen Dank
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Wedi'i gopïo fel yr uchod ond pan fyddaf yn pwyso F5 does dim byd yn digwydd
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, Cathleen,
Mae'r cod uchod yn gweithio'n iawn yn fy Outlook, pa fersiwn Outlook ydych chi'n ei ddefnyddio?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Mae gen i gyfrifon cyfnewid lluosog. Rwyf am gael un o'r cyfrifon nad yw'n ddiofyn i mi fod yr anfonwr. Ble byddwn i'n mewnosod hwn yn y cod? Diolch!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Unrhyw un yn cael rhai e-byst wedi'u hanfon i'r ffolder sydd wedi'i ddileu yn gwneud hyn?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, Bill,
Ydych chi am anfon nifer o e-byst dethol o borthiant sydd wedi'u dileu?
Rhowch eich problem yn fwy manwl, diolch!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo skyyang, rwy'n wynebu'r un broblem. Fel arfer rwy'n drafftio 15-20 o negeseuon e-bost ac yna'n defnyddio'r cod hwn i'w hanfon i gyd ar unwaith, ond yn ddiweddarach yn sylweddoli nad yw un o'r negeseuon e-bost hynny'n cael eu hanfon, yn hytrach maen nhw'n cael eu hanfon i fy ffolder 'Dileu'. Mae hyd yn oed yr anogwr yn dweud y nifer cywir o negeseuon e-bost ar gyfer ee: '20 e-bost wedi'u hanfon' ond pan fyddaf yn gwirio, dim ond 19 fyddai wedi'u hanfon, bydd un yn gorwedd yn fy ffolder eitemau wedi'u dileu. Rwyf am i'r holl negeseuon e-bost gael eu hanfon at eu derbynwyr heb gamgymeriad. A allwch ddweud wrthyf pam mae hyn yn digwydd. Helpwch os gwelwch yn dda.
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, Darewin, Rydym wedi diweddaru'r codau uchod, ceisiwch eto, diolch!
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Yr un broblem: os dewiswch 4 neges, ar ôl anfon tri ohonynt yn y ffolder sbwriel (oherwydd y datganiad "xDraftsItems.Item(i).Delete")
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Defnyddiwyd y sgript i anfon pob e-bost drafft ar unwaith ar gyfer swp o negeseuon e-bost datganiad a gynhyrchwyd gan saets 200. Mae'r e-byst yn yr eitemau a anfonwyd yn edrych yn iawn ond mae cwsmeriaid yn eu derbyn gyda'r corff testun yn Tsieinëeg! Unrhyw syniadau beth allai fod yn digwydd yma?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Allwch chi esbonio pam mae'r post olaf (i = 1) yn cael ei ail-greu mewn MailItem newydd yn lle dim ond .Send?

Diolch.
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, cwestiwn cyflym efallai bod gennych chi syniad. Mae gennym raglen allanol sy'n cadw pob post i'r ffolder drafftiau. os ydw i'n rhedeg y macro mae gennym ni'r broblem, mai dim ond y post cyntaf yn y rhestr sy'n cael ei anfon yn gywir, mae pob post arall yn cael ei ohirio oherwydd ei fod yn ychwanegu dyfynodau i'r cyfeiriad post. A oes ffordd i osgoi hyn?
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Mae'r cod hwn yn anfon pob drafft mewn is-ffolder o'r enw Merge Tools (mae'n gofyn i chi cyn ei anfon). Ond rwy'n siŵr y gallwch chi ei olygu i weddu i'ch anghenion. Mae'n llawer symlach. Mwynhewch :)
Is-SendAllMergeToolsDrafftiau()

Os MsgBox("Ydych chi'n siŵr eich bod am anfon POB eitem yn eich ffolder drafftiau Merge Tools?", _
vbQuestion + vbYesNo) <> vbYes Then Exit Sub

Dim myNamespace Fel Outlook.NameSpace 'Newid yr olwg i'r Blwch Derbyn i osgoi gwall mewnol
Gosod myNamespace = Application.GetNamespace("MAPI") 'Newid gwedd i'r Blwch Derbyn i osgoi gwall mewnol
Gosod Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) 'Newid gwedd i'r Blwch Derbyn i osgoi gwall mewnol

Dim fldDraft Fel MAPIFolder, msg Fel Outlook.MailItem, inCount As Integer
Gosod fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).Ffolders("Merge Tools") 'Yn anfon pob drafft yn y ffolder Uno Offer yn unig
inCount = 0
Gwnewch Tra fldDraft.Items.count > 0
Gosod msg = fldDraft.Items(1)
msg.Anfon
intCount = intCount + 1
dolen
Os Nac ydy (msg Ydy Dim) Yna Gosodwch msg = Dim byd
Gosod fldDraft = Dim byd
MsgBox intCount & " negeseuon wedi'u hanfon", vbInformation + vbOKOnly

Is-End
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo bois. Wedi meddwl y byddwn i'n rhannu. Dyma fy nghod ar gyfer anfon pob drafft:
‘SendAllDrafts()’ Gan jamesmalcolmwood@gmail.com

If MsgBox("Ydych chi'n siŵr eich bod am anfon POB eitem yn eich ffolder drafftiau?", _
vbQuestion + vbYesNo) <> vbYes Then Exit Sub

Dim myNamespace Fel Outlook.NameSpace 'Newid yr olwg i'r Blwch Derbyn i osgoi gwall mewnol
Gosod myNamespace = Application.GetNamespace("MAPI") 'Newid gwedd i'r Blwch Derbyn i osgoi gwall mewnol
Gosod Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) 'Newid gwedd i'r Blwch Derbyn i osgoi gwall mewnol

Dim fldDraft Fel MAPIFolder, msg Fel Outlook.MailItem, inCount As Integer
Gosod fldDraft = Outlook.GetNamespace ("MAPI").GetDefaultFolder(olFolderDrafts) 'Yn anfon pob drafft yn eich prif ffolder drafftiau. Ar gyfer is-ffolder, ychwanegwch .Folders ("enw'r ffolder")
inCount = 0
Gwnewch Tra fldDraft.Items.count > 0
Gosod msg = fldDraft.Items(1)
msg.Anfon
intCount = intCount + 1
dolen
Os Nac ydy (msg Ydy Dim) Yna Gosodwch msg = Dim byd
Gosod fldDraft = Dim byd
MsgBox intCount & " negeseuon wedi'u hanfon", vbInformation + vbOKOnly

Is-End
Nid oes unrhyw sylwadau wedi'u postio yma eto
Gadewch eich sylwadau
Postio fel Gwestai
×
Graddiwch y swydd hon:
0   Cymeriadau
Lleoliadau a Awgrymir

Dilynwch ni

Hawlfraint © 2009 - www.extendoffice.com. | Cedwir pob hawl. Wedi ei bweru gan ExtendOffice. | Map o'r safle
Mae Microsoft a logo'r Swyddfa yn nodau masnach neu'n nodau masnach cofrestredig Microsoft Corporation yn yr Unol Daleithiau a / neu wledydd eraill.
Wedi'i warchod gan Sectigo SSL