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

  • Pergunta

  • 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?

    quinta-feira, 15 de março de 2012 20:00

Respostas

  • 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

    sexta-feira, 16 de março de 2012 19:41
    Moderador

Todas as Respostas

  • É 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 = "benzadeus@ambienteoffice.com.br; felipebenza@hotmail.com"
            .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

    quinta-feira, 15 de março de 2012 23:29
    Moderador
  • 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...

    sexta-feira, 16 de março de 2012 14:28
  • 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

    sexta-feira, 16 de março de 2012 19:41
    Moderador