Visual Basic - ADD HIPERLINK CON EMAIL ADDRESS

ADD HIPERLINK CON EMAIL ADDRESS

Publicado por Eduardol (10 intervenciones) el 01/09/2021 05:58:17

Hola amigos, tengo un problema con excel, he realizado una formula para generar automaticamente unos emails utilizando el metodo HIPERVINCULO, de la siguiente manera. =SI(R4="";"";HIPERVINCULO("mailto:"&C4&"?subject=Saldos Disponibles&body="&R4;"Enviar Email")) en donde R4 es el body del mail, es otra formula. El problema es que excel no puede resolver esta formula si la misma supera los 255 caracteres.

Por lo tanto he encontrado que la forma de sortear este inconveniente es haciendo una macro.

Mis conocimentos en esta materia son bastante limitados, pero puedo entender el codigo, y la primera parte del mismo, no es lo que necesito, sino que el evento que activa el codigo tiene que ser otro, como que cierta celda tenga un valor determinado.

Tambien me gustaria saber, si codigo de add subaddress se le puede agregar el body del email, y como?

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row = 1 Then Exit Sub ' IF ITS A HEADER, DO NOTHING.

If Trim(Target.Text) <> "" Then
addHyperLink
End If

End Sub

Sub addHyperLink()

On Error GoTo ErrHandler
Application.ScreenUpdating = False

Dim myDataRng As Range
Dim cell As Range

Set myDataRng = Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row)

Application.Worksheets("Sheet2").Columns(1).ClearContents
Application.Worksheets("Sheet2").Cells(1, 1) = "Critical Log"

For Each cell In myDataRng

If cell(myDataRng.Row, 1).Text < Val(cell(myDataRng.Row, 0).Text) Then

' ADD ADDRESS.
Application.ActiveSheet.Hyperlinks.Add _
Anchor:=Application.ActiveSheet.Cells(cell.Row, cell.Column + 1), _
Address:="mailto:[email protected]?subject=Sales Report", _
SubAddress:="", _
ScreenTip:="Critical", _
TextToDisplay:="Mail this Figure"

' ADD SUB-ADDRESS
Application.Worksheets("Sheet2").Hyperlinks.Add _
Anchor:=Application.Worksheets("Sheet2").Cells(cell.Row, 1), _
Address:="", _
SubAddress:=Application.ActiveSheet.Name & "!" & cell.Address, _
ScreenTip:="Critical", _
TextToDisplay:="Check Figure"
End If
Next cell

Set myDataRng = Nothing
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Bueno, espero que alguien lea mi consulta y me ayude.

Muchas gracias!

Enviado-de-Mails-macro-excel.zip(25,1 KB)

Valora esta pregunta

Me gusta: Está pregunta es útil y esta clara

No me gusta: Está pregunta no esta clara o no es útil

Responder

ADD HIPERLINK CON EMAIL ADDRESS

Publicado por Eduardol (10 intervenciones) el 20/12/2021 05:19:26

Bueno, creo que ya lo tengo, pero necesito ayuda,

Sub CreaLink()

Application.ScreenUpdating = False

Application.DisplayAlerts = False

'On Error Resume Next

Dim uf As String, texhip As String

Dim ws As Worksheet

Dim hyp As Hyperlink

Set a = Sheets("Base Emails")

pf = 4

uf = a.Range("A" & Rows.Count).End(xlUp).Row

For x = 5 To uf

    If a.Cells(x, "A") <> Empty Then

        'texhip = a.Cells(x, "H")

        'celhyper = a.Cells(x, «C»)

        MailAdress = a.Cells(x, "D")

        MailAdressCC = a.Cells(x, "E")

        MailAdressCCO = a.Cells(x, "F")

        MailBody = a.Cells(x, "H")

        MailLink = a.Cells(x, "J")

        'a.Hyperlinks.Add Anchor:=a.Cells(x, «A»), Address:=celhyper, SubAddress:=»», TextToDisplay:=texhip 'para subaddres escribir entre las comilllas o reempazar por var

        Set hyp = ws.Hyperlinks.Add(MailLink, _

            "mailto:" & MailAdress & "?cc=" & MailsAdressCC & ";segundacopia@destinatario.com&bcc=" & "&subject=Saldo Deudor&body=" & MailBody, " ", " Click para enviar email ", "Enviar Email")

'Me pide un objeto, Error 424

        conta = conta + 1

    End If

Next x

MsgBox ("Se crearon " & conta & " hiperlinks")

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub

Valora esta respuesta

Me gusta: Está respuesta es útil y esta clara

No me gusta: Está respuesta no esta clara o no es útil

Comentar