Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Visual Basic para Aplicaciones » hipervinculos para enviado de emails

Visual Basic para Aplicaciones - hipervinculos para enviado de emails

Life is soft - evento anual de software empresarial
Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil

hipervinculos para enviado de emails

Publicado por Eduardol (35 intervenciones) el 03/09/2021 02:35:10
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!
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
sin imagen de perfil

hipervinculos para enviado de emails

Publicado por Eduardol (35 intervenciones) el 16/12/2021 04:00:40
Despues de mucho tiempo buscando y realizando pruebas lo consegui.

aqui les dejo el codigo base.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub CreateMailLink()
    Dim ws As Worksheet, hyp As Hyperlink
    Set ws = ActiveSheet
    ' Create an email link.
 
 
 
      'Set hyp = ws.Hyperlinks.Add([a3], _
     "mailto:direccion@destinatario.com?cc=copia@destinatario.com;segundacopia@destinatario.com&bcc=copiaoculta@destinatario.com&subject=Asunto%20con%20espacios&body=Este%20es%20el%20cuerpo%20del%20mensaje")
 
      Set hyp = ws.Hyperlinks.Add([a4], _
     "mailto:" & [d2] & "?cc=" & [e2] & ";segundacopia@destinatario.com&bcc=" & [f2] & "&subject=" & [g2] & "&body=" & [h2], " ", " Click para enviar email ", "Enviar Email")
 
         ' Change the subject...
    hyp.EmailSubject = "Different subject"
  End Sub

Espero que les sirva.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

hipervinculos para enviado de emails

Publicado por Eduardol (35 intervenciones) el 18/12/2021 14:19:27
Bueno, necesito ayuda con este codigo.

En el codigo estan los comentarios.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Private Sub Worksheet_Calculate()
Dim libroexcel As String
'fila = ActiveCell.Row
Dim Email As Range
Dim pp As Integer
Dim pepe As Integer
Dim ws As Worksheet, hyp As Hyperlink
 
Set ws = ActiveSheet
Set Email = Range("C" + pp)
 
    If Email <> "" Then
        pp = 4
        pepe = 0
        Do While pepe = 0
 
    ' Create an email link.
    'Set hyp = ws.Hyperlinks.Add([a3], _
     "mailto:direccion@destinatario.com?cc=copia@destinatario.com;segundacopia@destinatario.com&bcc=copiaoculta@destinatario.com&subject=Asunto%20con%20espacios&body=Este%20es%20el%20cuerpo%20del%20mensaje")
 
      Set hyp = ws.Hyperlinks.Add([I + pp], _
     "mailto:" & [c+pp] & "?cc=" & [d+pp] & ";segundacopia@destinatario.com&bcc=" & [+pp] & "&subject=" & [H+pp] & "&body=" & [g+pp], " ", " Click para enviar email ", "Enviar Email")
 
     'La columna "C" contiene las direcciones de correo electronico
     'La Columna "D" contiene las direcciones de correo electronico a la que se le remite una copia
     'La Columna "E" contiene las direcciones de correo electronico a la que se le remite una copia oculta
     'La Columna "H" contiene el Asunto del correo
     'La columna "G" contiene una concatenacion de valores que surgen de distintas comlumnas para conformar el el cuerpo del correo
 
     'La idea es que se generen los hipervinculos a partir del evento "Calculate", es decir, primero el usuario activa la Macro "Consultar Emails", y una vez que se vuelcan los valores resultados_
     'de esa macro, se general los links automaticamente.
 
    ' Change the subject...
    hyp.EmailSubject = "Saldo Deudor"
 
 
 
    Else 'me pide un IF pero arriba hay uno, no entiendo!!!!
        pepe = 1
        'If cuit = 0 Then
        Exit Do
        End If
        Else
        pp = pp + 1
 
 
        Loop
 
 
   End If
 
 
 
 
 
End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

hipervinculos para enviado de emails

Publicado por Eduardol (35 intervenciones) el 20/12/2021 05:18:11
Bueno, creo que ya lo tengo, pero necesito ayuda,

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
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 claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar