EXCEL VBA, remetente manual do email do Outlook, edição do módulo de classe
Ainda estou trabalhando no problema que descrevi no meu1ª questão neste tópico. Para uma breve atualização, é um arquivo do Excel que contém a lista de modelos e anexos de email. Em cada unidade de lista, adiciono o botão que abre o modelo da unidade fornecedora, faz algumas alterações, anexa os arquivos e exibe o correio para o Do utilizador. O usuário pode alterar o correio, se necessário, e depois enviar ou não o envio. Eu tentei várias abordagens descritas abaixo. Infelizmente, agora estou parado no problema com o módulo de classe, que brevemente descreveuaqui. Eu criei um módulo de classe, como 'EmailWatcher' e até faço uma pequena combinação com o método descritoaqui:
Option Explicit
Public WithEvents TheMail As Outlook.MailItem
Private Sub Class_Terminate()
Debug.Print "Terminate " & Now()
End Sub
Public Sub INIT(x As Outlook.MailItem)
Set TheMail = x
End Sub
Private Sub x_Send(Cancel As Boolean)
Debug.Print "Send " & Now()
ThisWorkbook.Worksheets(1).Range("J5") = Now()
'enter code here
End Sub
Private Sub Class_Initialize()
Debug.Print "Initialize " & Now()
End Sub
A alteração no seguinte formulário não faz nenhuma alteração:
Option Explicit
Public WithEvents TheMail As Outlook.MailItem
Private Sub Class_Terminate()
Debug.Print "Terminate " & Now()
End Sub
Public Sub INIT(x As Outlook.MailItem)
Set TheMail = x
End Sub
Private Sub TheMail_Send(Cancel As Boolean)
Debug.Print "Send " & Now()
ThisWorkbook.Worksheets(1).Range("J5") = Now()
'enter code here
End Sub
Private Sub Class_Initialize()
Debug.Print "Initialize " & Now()
End Sub
O código do módulo é o seguinte:
Public Sub SendTo()
Dim r, c As Integer
Dim b As Object
Set b = ActiveSheet.Buttons(Application.Caller)
With b.TopLeftCell
r = .Row
c = .Column
End With
Dim filename As String, subject1 As String, path1, path2, wb As String
Dim wbk As Workbook
filename = ThisWorkbook.Worksheets(1).Cells(r, c + 5)
path1 = Application.ThisWorkbook.Path &
ThisWorkbook.Worksheets(1).Range("F4")
path2 = Application.ThisWorkbook.Path &
ThisWorkbook.Worksheets(1).Range("F6")
wb = ThisWorkbook.Worksheets(1).Cells(r, c + 8)
Dim outapp As Outlook.Application
Dim oMail As Outlook.MailItem
Set outapp = New Outlook.Application
Set oMail = outapp.CreateItemFromTemplate(path1 & filename)
subject1 = oMail.subject
subject1 = Left(subject1, Len(subject1) - 10) &
Format(ThisWorkbook.Worksheets(1).Range("D7"), "DD/MM/YYYY")
oMail.Display
Dim CurrWatcher As EmailWatcher
Set CurrWatcher = New EmailWatcher
CurrWatcher.INIT oMail
Set CurrWatcher.TheMail = oMail
Set wbk = Workbooks.Open(filename:=path2 & wb)
wbk.Worksheets(1).Range("I4") =
ThisWorkbook.Worksheets(1).Range("D7").Value
wbk.Close True
ThisWorkbook.Worksheets(1).Cells(r, c + 4) = subject1
With oMail
.subject = subject1
.Attachments.Add (path2 & wb)
End With
With ThisWorkbook.Worksheets(1).Cells(r, c - 2)
.Value = Now
.Font.Color = vbWhite
End With
With ThisWorkbook.Worksheets(1).Cells(r, c - 1)
.Value = "Was opened"
.Select
End With
End Sub
Finalmente, criei uma classe que está funcionando e coloquei alguns controles para verificá-la como você pode ver no código do módulo de classe. Mas o problema é que ele não captura o evento Send. A classe está terminando no final do sub. Deixando o email totalmente para o Usuário. A questão é: onde está o erro? Ou como deixar o módulo de classe no chamado "modo de espera" ou talvez outras sugestões? Também considero a maneira de procurar e-mails na 'caixa de saída', mas a abordagem com o evento Enviar é muito mais favorável.