Tengo un libro de trabajo que al menos 15 personas usan y actualizan periódicamente que contiene información del cliente con correos electrónicos dentro de la columna H3: H1500. Usando el evento Worksheet_FollowHyperlink, podemos enviar correos electrónicos a través de nuestras cuentas de Outlook que están preescritas y dependen de qué día de la semana se solicite un pedido (lunes a viernes, sábado y domingo) y el código funciona bien para generar mensajes.Mi principal problema es rastrear las respuestas a los clientes. Intenté tener un sub que registrara la fecha (función NOW) y Environ ("nombre de usuario") cada vez que se seleccionó el hipervínculo dentro de la columna H, pero como tengo el subconjunto de correo electrónico configurado en .Display (para que las personas puedan hacer ajustes de última hora) , si es necesario) solo registra quién seleccionó el hipervínculo (que, aparentemente, ocurre mucho por accidente cuando el mensaje nunca se envía). Encontré varios hilos a lo largo de este foro y otros que hacen referencia a la creación de un módulo de Clase e implementé uno que se usó para ver si funcionaría en mi código, pero al agregarlo, el correo electrónico completo se volvió inútil, así que volví a La vieja forma. Como no tengo mucha experiencia en VBA (he llegado tan lejos debido a la ayuda y la prueba y error), me doy cuenta de que algunas de mis opciones de código pueden parecer tontas, y si hay mejores formas de hacerlo, estoy abierto a - Solo sé que esta hoja funcionaprincipalmente por ahora y espero que pueda mejorarse, si es posible.

Mi correo electrónico actual es:

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

[El código anterior está en Excel VBE, el siguiente código está en Outlook VBE, debería haberlo incluido antes de comenzar, ahora me está funcionando bien, así que no estoy seguro de por qué no se 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

Cualquier ayuda es apreciada!