Eu tenho usado a macro do Outlook para mover todos os rascunhos diretamente para a caixa de saída:
Sub SendAllDrafts()
' Send the messages in the Drafts folder (ignore any subfolders)
If MsgBox("Are you sure you want to send ALL the items in your default Drafts folder?", _
vbQuestion + vbYesNo) <> vbYes Then Exit Sub
Dim fldDraft As MAPIFolder, msg As Outlook.MailItem, intCount As Integer
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts)
intCount = 0
Do While fldDraft.Items.Count > 0
Set msg = fldDraft.Items(1)
msg.Send
intCount = intCount + 1
Loop
If Not (msg Is Nothing) Then Set msg = Nothing
Set fldDraft = Nothing
MsgBox intCount & " messages sent", vbInformation + vbOKOnly
End Sub
A macro funciona em uma conta, mas quando mudo para uma conta diferente, recebo um erro: "Erro em tempo de execução '-2147467259 (80004005)': o Outlook não reconhece um ou mais nomes." Quando eu pressiono o debug, ele aponta uma seta amarela na linha "msg.Send".
Tags microsoft-outlook macros vba