Usuário com melhor resposta
Alterando Outlook para "Trabalhando Offline" através de macro no Excel

Pergunta
-
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 IfEnd 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
- Sugerido como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 7 de junho de 2014 21:47
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 7 de junho de 2014 21:47
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
-
-
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 IfEnd 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
- Sugerido como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 7 de junho de 2014 21:47
- Marcado como Resposta Felipe Costa GualbertoMVP, Moderator sábado, 7 de junho de 2014 21:47