Epirus

Bem-Vindo, Visitante
Username: Password: Lembrar-me

TÓPICO: Chamar uma função entre aplicativos do Office (Excel e Outlook).

Chamar uma função entre aplicativos do Office (Excel e Outlook). 4 anos 7 mêses ago #519

  • Joel
  • Joel's Avatar
  • OFFLINE
  • Senior Boarder
  • Postagens: 46
  • Thank you received: 1
  • Karma: 0
Bom Dia!

Tenho uma função em Vba no Outlook 2010 que envia e-mail.

Duvida, existe a possibilidade de eu criar uma rotina no Excel que chama a função no Outlook.

Exemplo

Função Outlook

enviar_email(to,assunto,cc,anexo,cco)

sub rotina no Excel

carregar as variareis do Outlook (to,assunto,cc,anexo,cco) e chamar a função enviar e-mail.
O administrador desabilitou o acesso público de escrita.

Chamar uma função entre aplicativos do Office (Excel e Outlook). 4 anos 7 mêses ago #520

  • Robert Martim
  • Robert Martim's Avatar
  • OFFLINE
  • Administrator
  • Postagens: 274
  • Thank you received: 23
  • Karma: 4
Você pode fazer isso direto do Excel onde ele cria o E-mail para você. Neste caso, estando ou não o Outlook aberto, ele vai forçar a criação do e-mail.

Além de mais rápido é mais limpo...

Eu particularmente não conheço método do aplicativo Outlook que possa ser executado por fora, como o Run do Excel. Somente pesquisando...
O administrador desabilitou o acesso público de escrita.

Chamar uma função entre aplicativos do Office (Excel e Outlook). 4 anos 7 mêses ago #521

  • Joel
  • Joel's Avatar
  • OFFLINE
  • Senior Boarder
  • Postagens: 46
  • Thank you received: 1
  • Karma: 0
esse fato me occoreu com o código que pesquisei abaixo para evitar a mensagem de envio de e-amil do Outlook.

no site o procedimento é colocar o código no outlook e depois executar outra rotina em qualquer aplicativo, no caso de exemplo é o Access.

Conforme informação do site a Rotina abaixo deve ser colocada no Outllook
*****************************************************************************************

Option Explicit

' Code: Send E-mail without Security Warnings
' OUTLOOK 2003 VBA CODE FOR 'ThisOutlookSession' MODULE
' (c) 2005 Wayne Phillips (www.everythingaccess.com)
' Written 07/05/2005
' Last updated v1.4 - 26/03/2008
'
' Please read the full tutorial here:
' www.everythingaccess.com/tutorials.asp?ID=112
'
' Please leave the copyright notices in place - Thank you.

Private Sub Application_Startup()

'IGNORE - This forces the VBA project to open and be accessible
' using automation at any point after startup

End Sub

' FnSendMailSafe
'
' Simply sends an e-mail using Outlook/Simple MAPI.
' Calling this function by Automation will prevent the warnings
' 'A program is trying to send a mesage on your behalf...'
' Also features optional HTML message body and attachments by file path.
'
' The To/CC/BCC/Attachments function parameters can contain multiple items
' by seperating them with a semicolon. (e.g. for the strTo parameter,
' 'O endereço de e-mail address está sendo protegido de spambots. Você precisa ativar o JavaScript enabled para vê-lo. ; O endereço de e-mail address está sendo protegido de spambots. Você precisa ativar o JavaScript enabled para vê-lo. ' would be acceptable for sending to
' multiple recipients.
'
Public Function FnSendMailSafe(strTo As String, _
strCC As String, _
strBCC As String, _
strSubject As String, _
strMessageBody As String, _
Optional strAttachments As String) As Boolean

' (c) 2005 Wayne Phillips - Written 07/05/2005
' Last updated 26/03/2008 - Bugfix for empty recipient strings
' www.everythingaccess.com
'
' You are free to use this code within your application(s)
' as long as the copyright notice and this message remains intact.

On Error GoTo ErrorHandler:

Dim MAPISession As Outlook.NameSpace
Dim MAPIFolder As Outlook.MAPIFolder
Dim MAPIMailItem As Outlook.MailItem
Dim oRecipient As Outlook.Recipient

Dim TempArray() As String
Dim varArrayItem As Variant
Dim strEmailAddress As String
Dim strAttachmentPath As String

Dim blnSuccessful As Boolean

'Get the MAPI NameSpace object
Set MAPISession = Application.Session

If Not MAPISession Is Nothing Then

'Logon to the MAPI session
MAPISession.Logon , , True, False

'Create a pointer to the Outbox folder
Set MAPIFolder = MAPISession.GetDefaultFolder(olFolderOutbox)
If Not MAPIFolder Is Nothing Then

'Create a new mail item in the "Outbox" folder
Set MAPIMailItem = MAPIFolder.Items.Add(olMailItem)
If Not MAPIMailItem Is Nothing Then

With MAPIMailItem

'Create the recipients TO
TempArray = Split(strTo, ";")
For Each varArrayItem In TempArray

strEmailAddress = Trim(varArrayItem)
If Len(strEmailAddress) > 0 Then
Set oRecipient = .Recipients.Add(strEmailAddress)
oRecipient.Type = olTo
Set oRecipient = Nothing
End If

Next varArrayItem

'Create the recipients CC
TempArray = Split(strCC, ";")
For Each varArrayItem In TempArray

strEmailAddress = Trim(varArrayItem)
If Len(strEmailAddress) > 0 Then
Set oRecipient = .Recipients.Add(strEmailAddress)
oRecipient.Type = olCC
Set oRecipient = Nothing
End If

Next varArrayItem

'Create the recipients BCC
TempArray = Split(strBCC, ";")
For Each varArrayItem In TempArray

strEmailAddress = Trim(varArrayItem)
If Len(strEmailAddress) > 0 Then
Set oRecipient = .Recipients.Add(strEmailAddress)
oRecipient.Type = olBCC
Set oRecipient = Nothing
End If

Next varArrayItem

'Set the message SUBJECT
.Subject = strSubject

'Set the message BODY (HTML or plain text)
If StrComp(Left(strMessageBody, 6), "<HTML>", _
vbTextCompare) = 0 Then
.HTMLBody = strMessageBody
Else
.Body = strMessageBody
End If

'Add any specified attachments
TempArray = Split(strAttachments, ";")
For Each varArrayItem In TempArray

strAttachmentPath = Trim(varArrayItem)
If Len(strAttachmentPath) > 0 Then
.Attachments.Add strAttachmentPath
End If

Next varArrayItem

.Send 'The message will remain in the outbox if this fails

Set MAPIMailItem = Nothing

End With

End If

Set MAPIFolder = Nothing

End If

MAPISession.Logoff

End If

'If we got to here, then we shall assume everything went ok.
blnSuccessful = True

ExitRoutine:
Set MAPISession = Nothing
FnSendMailSafe = blnSuccessful

Exit Function

ErrorHandler:
MsgBox "An error has occured in the user defined Outlook VBA function " & _
"FnSendMailSafe()" & vbCrLf & vbCrLf & _
"Error Number: " & CStr(Err.Number) & vbCrLf & _
"Error Description: " & Err.Description, _
vbApplicationModal + vbCritical
Resume ExitRoutine
********************************************************************************

Depois coloco num modulo a rotina abaixo e executo o código
Option Compare Database

Option Explicit

' ACCESS VBA MODULE: Send E-mail without Security Warning
' (c) 2005 Wayne Phillips (www.everythingaccess.com)
' Written 07/05/2005
' Last updated v1.3 - 11/11/2005
'
' Please read the full tutorial & code here:
' www.everythingaccess.com/tutorials.asp?I...out-Security-Warning
'
' Please leave the copyright notices in place - Thank you.


'This is a test function - replace the e-mail addresses with your own before executing!!
'(CC/BCC can be blank strings, attachments string is optional)


Sub FnTestSafeSendEmail()
Dim blnSuccessful As Boolean
Dim strHTML As String

strHTML = "<html>" & _
"<body>" & _
"My <b><i>HTML</i></b> message text!" & _
"</body>" & _
"</html>"
blnSuccessful = FnSafeSendEmail("O endereço de e-mail address está sendo protegido de spambots. Você precisa ativar o JavaScript enabled para vê-lo. ", _
"My Message Subject", _
"Corpo")


'A more complex example...
'blnSuccessful = FnSafeSendEmail("O endereço de e-mail address está sendo protegido de spambots. Você precisa ativar o JavaScript enabled para vê-lo. ; O endereço de e-mail address está sendo protegido de spambots. Você precisa ativar o JavaScript enabled para vê-lo. ", _
"My Message Subject", _
strHTML, _
"C:\MyAttachmentFile1.txt; C:\MyAttachmentFile2.txt", _
"O endereço de e-mail address está sendo protegido de spambots. Você precisa ativar o JavaScript enabled para vê-lo. ", _
"O endereço de e-mail address está sendo protegido de spambots. Você precisa ativar o JavaScript enabled para vê-lo. ")

If blnSuccessful Then

MsgBox ".: Mensagem de E-mail enviada com sucesso!"

Else

MsgBox ":. Falha ao enviar e-mail!"

End If

End Sub


'This is the procedure that calls the exposed Outlook VBA function...

Public Function FnSafeSendEmail(strTo As String, _
strSubject As String, _
strMessageBody As String, _
Optional strAttachmentPaths As String, _
Optional strCC As String, _
Optional strBCC As String) As Boolean

Dim objOutlook As Object ' Note: Must be late-binding.
Dim objNameSpace As Object
Dim objExplorer As Object
Dim blnSuccessful As Boolean
Dim blnNewInstance As Boolean


'Is an instance of Outlook already open that we can bind to?

On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0

If objOutlook Is Nothing Then


'Outlook isn't already running - create a new instance...

Set objOutlook = CreateObject("Outlook.Application")
blnNewInstance = True

'We need to instantiate the Visual Basic environment... (messy)

Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objExplorer = objOutlook.Explorers.Add(objNameSpace.Folders(1), 0)
objExplorer.CommandBars.FindControl(, 1695).Execute

objExplorer.Close

Set objNameSpace = Nothing
Set objExplorer = Nothing

End If

blnSuccessful = objOutlook.FnSendMailSafe(strTo, strCC, strBCC, _
strSubject, strMessageBody, _
strAttachmentPaths)


If blnNewInstance = True Then objOutlook.Quit
Set objOutlook = Nothing

FnSafeSendEmail = blnSuccessful

End Function

O problema é que quando fui testar deu erro de tempo em execução 438 e parou no fianl do código no access


Gerou erro aqui:
blnSuccessful = objOutlook.FnSendMailSafe(strTo, strCC, strBCC, _
strSubject, strMessageBody, _
strAttachmentPaths)



Por isso estou tentando verificar como ele chama a função no Outlook que não gera mensagem de erro a enviar e-mail.

Obs: Já vi no seu curso de vba como enviar com o Redemption.
O administrador desabilitou o acesso público de escrita.

Chamar uma função entre aplicativos do Office (Excel e Outlook). 4 anos 7 mêses ago #522

  • Robert Martim
  • Robert Martim's Avatar
  • OFFLINE
  • Administrator
  • Postagens: 274
  • Thank you received: 23
  • Karma: 4
Você pode usar o Redemption para fazer isso. Eu tenho um exemplo que fiz de muitos anos atrás em:

www.msofficegurus.com/post/Using-Redempt...Outlook-message.aspx

É bem mais simples que o postado acima (que nem li, para ser honesto :whistle: )
O administrador desabilitou o acesso público de escrita.

Chamar uma função entre aplicativos do Office (Excel e Outlook). 4 anos 7 mêses ago #523

  • Joel
  • Joel's Avatar
  • OFFLINE
  • Senior Boarder
  • Postagens: 46
  • Thank you received: 1
  • Karma: 0
Já Tinha visto no Seu curso o Redemption.

porem fiz tudo como pede e rodou o código sem erro, porem não enviou o e-mail.

Obs. eu utilizo 2 contas de e-mail no meu outlook.
O administrador desabilitou o acesso público de escrita.

Chamar uma função entre aplicativos do Office (Excel e Outlook). 4 anos 7 mêses ago #524

  • Joel
  • Joel's Avatar
  • OFFLINE
  • Senior Boarder
  • Postagens: 46
  • Thank you received: 1
  • Karma: 0
Olha o exemplo que testei.
Utilizo o Outlook 2013.


Sub SendError()


Dim appOL As Outlook.Application
Dim olEmail As Outlook.MailItem
Dim safeEmail As Redemption.SafeMailItem
Dim strMsg As String
Dim strEmailMsg As String
strMsg = "Um erro ocorreu neste aplicativo. Um e-mail será "
strMsg = strMsg & "criado e enviado para a Micosoft para futura "
strMsg = strMsg & "correção do erro. Ajude-nos a fazer um software "
strMsg = strMsg & "melhor. Nenhuma informação pessoal será coletada "
strMsg = strMsg & "e você poderá checar o e-mail antes do envio. "
strMsg = strMsg & vbCr & vbCr & "Deseja continuar?"
If Not (MsgBox(strMsg, vbQuestion + vbYesNo, "Um erro ocorreu...")) = _
vbYes Then Exit Sub
On Error Resume Next
Set appOL = GetObject(, "Outlook.Application")
If appOL Is Nothing Then Set appOL = CreateObject("Outlook.Application")
Set olEmail = appOL.CreateItem(olMailItem)
Set safeEmail = CreateObject("Redemption.SafeMailItem")
strEmailMsg = "Erro ocorrido em: " & Now & vbCr
strEmailMsg = strEmailMsg & "Procedimento: " & strProcName & vbCr
strEmailMsg = strEmailMsg & "Núm. do erro: " & lngErrNum & vbCr
strEmailMsg = strEmailMsg & "Desc. do erro: " & strErrDesc

With safeEmail
.Item = olEmail
.Recipients.Add "O endereço de e-mail address está sendo protegido de spambots. Você precisa ativar o JavaScript enabled para vê-lo. "
.Recipients.ResolveAll
.Subject = "Erro no sistema..."
.Body = strEmailMsg
.Send
'.Display
End With
End Sub
O administrador desabilitou o acesso público de escrita.

Chamar uma função entre aplicativos do Office (Excel e Outlook). 4 anos 7 mêses ago #525

  • Joel
  • Joel's Avatar
  • OFFLINE
  • Senior Boarder
  • Postagens: 46
  • Thank you received: 1
  • Karma: 0
O meu sistema operacional é 64bits, existe diferença?
O administrador desabilitou o acesso público de escrita.

Chamar uma função entre aplicativos do Office (Excel e Outlook). 4 anos 7 mêses ago #526

  • Robert Martim
  • Robert Martim's Avatar
  • OFFLINE
  • Administrator
  • Postagens: 274
  • Thank you received: 23
  • Karma: 4
Qual erro deu?
O administrador desabilitou o acesso público de escrita.

Chamar uma função entre aplicativos do Office (Excel e Outlook). 4 anos 7 mêses ago #527

  • Joel
  • Joel's Avatar
  • OFFLINE
  • Senior Boarder
  • Postagens: 46
  • Thank you received: 1
  • Karma: 0
Erro de tempo de execução -2147220998(80040fa):

Erro de Automação

Sistema operacional errado ou de versão incorreta para o aplicativo.

Rodei o código abaixo:


Sub sendMailThroughRedempetion()
Dim appOL As Outlook.Application
Dim myEmail As Outlook.MailItem
Dim mySafeEmail As Redemption.SafeMailItem
Set appOL = CreateObject("Outlook.Application")
Set myEmail = appOL.CreateItem(olMailItem)
Set mySafeEmail = CreateObject("Redemption.SafeMailItem")
With mySafeEmail
.Item = myEmail
.Recipients.Add "O endereço de e-mail address está sendo protegido de spambots. Você precisa ativar o JavaScript enabled para vê-lo. "
.Recipients.ResolveAll
.Subject = "My test redemption message"
.Body = "Body of my message"
.Send
End With
End Sub
O administrador desabilitou o acesso público de escrita.

Chamar uma função entre aplicativos do Office (Excel e Outlook). 4 anos 7 mêses ago #530

  • Robert Martim
  • Robert Martim's Avatar
  • OFFLINE
  • Administrator
  • Postagens: 274
  • Thank you received: 23
  • Karma: 4
O erro quer dizer que você tem a versão incorreta do Outlook em relação ao Redemption...
O administrador desabilitou o acesso público de escrita.
Time to create page: 0.433 seconds