Eu tenho uma pasta de trabalho que pelo menos 15 pessoas usam e atualizam periodicamente que contém informações do cliente com emails na coluna H3: H1500. Usando o evento Worksheet_FollowHyperlink, podemos enviar e-mails por meio de nossas contas do Outlook pré-escritas e dependentes do dia da semana em que um pedido é solicitado (M-F, sábado e domingo) e o código funciona perfeitamente para gerar mensagens.Meu principal problema está no rastreamento de respostas aos clientes. Tentei ter um sub que registrasse a data (função NOW) e o Environ ("nome de usuário") sempre que o hiperlink na coluna H fosse selecionado, mas como tenho o sub e-mail definido como .Display (para que as pessoas possam fazer ajustes de última hora) , se necessário), apenas registra quem selecionou o hiperlink (que, aparentemente, acontece muito por acidente quando a mensagem nunca é realmente enviada). Eu encontrei vários tópicos neste fórum e outros que fazem referência à criação de um módulo Classe e implementei um que era usado para ver se funcionaria no meu código, mas, adicionando-o, todo o sub email foi inútil, então eu voltei para a forma antiga. Como não tenho muita experiência em VBA (cheguei até aqui devido a ajuda, tentativa e erro), percebo que algumas das minhas opções de código podem parecer bobas, e se houver melhores maneiras de fazer isso, estou aberto a - eu apenas sei que, esta folha funcionana maioria das vezes por enquanto e espero que possa ser melhorado, se possível.

Meu sub e-mail atual é:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim Body1, Body2, Body3 As String
Dim olApp As Outlook.Application
Dim OlMail As Outlook.MailItem

On Error Resume Next
Application.EnableEvents = False

Set olApp = GetObject(,"Outlook.Application")

Do While olApp.Inspectors.Count = 0
DoEvents

Loop

Set olMail = olApp.Inspectors.Item(1).CurrentItem

With olMail

Body1 = "This is my weekday text"
Body2 = "This is my Saturday text"
Body3 = "This is my Sunday text"

.Subject = "Subject"
.Attachemnts.Add "C:\Path"
.CC = Target.Range.Offset(0,4).Text
.BCC = ""

If Target.Range.Offset(0,5).Text = "No" Then
.Body1
If Target.Range.Offset(0,5).Text = "Yes" Then
.Body2
If Target.Range.Offset(0,5).Text = "Sunday" Then
.Body3

.Display
End With

forward:
Application.EnableEvents = True
Exit Sub
halt:
MsgBox Err.Description
Resume forward
End Sub

[O código acima está no Excel VBE, o código a seguir está no Outlook VBE, eu deveria ter incluído isso antes de iniciar - ele está funcionando bem para mim no momento, então não sei por que não está compilando ...]

Function GetCurrentItem() As Object
Dim objApp As Application

Set objApp = CreateObject("Outlook.Application")
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
Set objApp = Nothing
End Function

Qualquer ajuda é apreciada!