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.
