Alterando Outlook para "Trabalhando Offline" através de macro no Excel

Question

Bom dia Pessoal,

Encaminho pelo Excel uma série de emails, mas gostaria que o Excel via macro mudasse o Outlook para "Trabalhando Offline" para que todos os emails ficassem na caixa de saída.

Alguém tem alguma ideia?

Answer 1

É possível alterar o Outlook para modo Offline via VBA, mas sugiro que ao invés de fazer isso, salve a série de e-mails nos seus rascunhos. Use uma rotina como:

Sub SalvaEmail()

    Dim appOutlook As Object
    Dim olMail As Object
    
    'Verifica se Outlook está aberto. Caso não esteja, criar nova instância
    On Error Resume Next
    Set appOutlook = GetObject(, "Outlook.Application")
    If appOutlook Is Nothing Then
        Set appoutlook = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    
    Set olMail = appOutlook.CreateItem(0) '0 é um item de e-mail
    
    With olMail
        .To = "[e-mail]; [e-mail]"
        .Subject = "Assunto"
        .Body = "A planilha de custos foi alterada."
        .Save
    End With
End Sub

O método .Save armazena os e-mails, e então você pode enviar todos os e-mails ao mesmo tempo, posteriormente.

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 2

Entendi, pode ser uma boa mesmo, vou tentar fazer assim, mas como faço para enviar todos os rascunhos de uma só vez?

E independente desta opção vc poderia me mostrar como tornar o Outlook Offline via Excel?

Abçs e Obrigado...

Answer 3

Para tornar o Outlook Offline via VBA:

Sub NowOffline()
    Dim ctl As Office.CommandBarControl
    Set ctl = ActiveExplorer.CommandBars.FindControl(, 5613)
    If ctl.Enabled Then
        ctl.Execute
    End If

End Sub()

Observação: não é possível torná-lo Online após executar essa macro. Você terá que reiniciar o Outlook para tal.

---

Para mandar todos os e-mails do Rascunho (não testei o código abaixo, retirei de: http://answers.google.com/answers/threadview?id=507207)

Public Sub SendDrafts()

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

'Send all items in the "Drafts" folder that have a "To" address filled

'Setup Outlook

Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders

'Set Draft Folder.  This will need modification based on where it's


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

'Loop through all Draft Items

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

'Check for "To" address and only send if "To" is filled in.

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

'Send Item

myDraftsFolder.Items.Item(lDraftItem).Send

End If
Next lDraftItem

'Clean-up

Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing

End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br