Отправьте электронное письмо с черновиковой папки

Question

с приведенным ниже кодированием VBA, я могу отправить все письма из папки Outlook, но единственная проблема заключается в том, что я должен предоставить имя родительской папки. Можем ли мы получить эту информацию с помощью кодирования, поскольку этот макрос будет использоваться другим пользователем, который не знаком с VBA.

Dim lDraftItem As Long 
Dim myOutlook As Outlook.Application 
Dim myNameSpace As Outlook.NameSpace 
Dim myFolders As Outlook.Folders 
Dim myDraftsFolder As Outlook.MAPIFolder 

Set myOutlook = Outlook.Application 
Set myNameSpace = myOutlook.GetNamespace("MAPI") 
Set myFolders = myNameSpace.Folders 
Set myDraftsFolder = myFolders("Gaus_Shaikh2@syntelinc.com").Folders("Drafts") 

For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1 

    If Len(Trim(myDraftsFolder.Items.Item(lDraftItem).To)) > 0 Then 
     myDraftsFolder.Items.Item(lDraftItem).Send 

    End If 

Next lDraftItem 

Answer 1

Замените эту строку:

Set myDraftsFolder = myFolders("Gaus_Shaikh2@syntelinc.com").Folders("Drafts") 

С этими тремя линиями:

Dim sUser As String 
sUser = myFolders.Item(2).Name 

Set myDraftsFolder = myFolders(sUser).Folders("Drafts") 

Имя второй папки будет именем учетной записи пользователя (адрес электронной почты), которые вы можете хранить в виде строки и переходить в myFolders(), чтобы квалифицировать свою конкретную учетную запись.

Answer 2

Это должно работать ...

Set myDraftsFolder = myNamespace.GetDefaultFolder(olFolderDrafts) 

* Редактировать *

код ниже, вероятно, лучше использовать функцию; он содержит проверку ошибок, поэтому любые сообщения электронной почты с недопустимыми полями в разделе «Кому» не должны прерывать функцию

Sub TestSendDrafts() 
    Call SendDraftMail 
End Sub 

Function SendDraftMail() As Boolean 
On Error GoTo ExitFunction 
    Dim ThisNameSpace As Outlook.NameSpace: Set ThisNameSpace = Application.GetNamespace("MAPI") 
    Dim DraftFolder As Outlook.MAPIFolder: Set DraftFolder = ThisNameSpace.GetDefaultFolder(olFolderDrafts) 

    Dim Var As Variant, i As Long, Difference As Long, SentItems As Long 
    For i = DraftFolder.Items.Count To 1 Step -1 
     Set Var = DraftFolder.Items.Item(i) 
     DoEvents 
     If Var.Class = olMail Then 
      If Len(Trim(Var.To)) > 0 Then 
       On Error Resume Next 
       Var.Send 
       If Err.Number = 0 Then SentItems = SentItems + 1 
       On Error GoTo ExitFunction 
      End If 
     End If 
    Next i 

    Debug.Print "Sent " & SentItems & " message(s) from 'Draft E-mail'." 
    SendDraftMail = True 

ExitFunction: 
End Function