Usar checkbox para que copie los datos de un textbox al objeto copia de envío de correo
Le envié a su correo copia del archivo del proyecto para que por favor me ayude, con esta situación:
En la hoja envío correo, use un userfrom para digitar previamente el correo y la clave del remitente, de esta manera no queda predefinido ningún correo. Pero no he podido usar un segundo checkbox para que al dar click sobre este automaticamente copie el dato del textbox1 (contiene el correo del remitente) en el objeto .CC. Así que al enviar el correo si se desea una copia del mismo le llegue al remitente.

Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
TextBox2.PasswordChar = ""
Else
TextBox2.PasswordChar = "*"
End If
End Sub
Private Sub CheckBox2_Click()
End Sub
Private Sub CommandButton1_Click()
If TextBox1.Value = "" Then
MsgBox "Ingrese su correo electrónico para enviarle una respuesta", vbExclamation
Exit Sub
End If
For i = 10 To Range("B" & Rows.Count).End(xlUp).Row
'Si hay errores, que continúe
On Error Resume Next
Set oMsg = CreateObject("CDO.Message")
Set oconf = CreateObject("CDO.Configuration")
oconf.Load -1
Set Flds = oconf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = TextBox1.Value
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = TextBox2.Value
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Update
End With
Mensaje = Range("B4").Value 'Mensaje del correo
With oMsg
Set .Configuration = oconf
.From = TextBox1.Value
.To = Cells(i, "B").Value 'listado de destinatarios
'.CC = TextBox1
.Subject = Range("B3").Value 'Asunto
.TextBody = Mensaje
archivo = Cells(i, "C").Value
If Dir(archivo) <> "" Then
.AddAttachment archivo
End If
.Send
End With
MsgBox "Mensaje enviado exitósamente", vbInformation, "GMail en Excel"
'Mostramos un mensaje, tanto si hay
'errores como si no los hay
'If Err = 0 Then
' MsgBox ("Se ha producido un error, y no se ha podido enviar el email.")
'Else
' MsgBox ("El email se ha enviado correctamente.")
'End If
If Err.Number = 0 Then
Cells(i, "D") = "El mail se envió con éxito"
Else
Cells(i, "D") = "Se produjo el siguiente error: " & Err.Number & " " & Err.Description
End If
'Set Email = Nothing
Next
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub Label10_Click()
End Sub
Private Sub textbox1_Exit(ByVal cancel As MSForms.ReturnBoolean)
If TextBox1.Value <> "" Then
With CreateObject("vbscript.regexp")
.Pattern = "^[\w-\.]+@([\w-]+\.)+[A-Za-z]{2,3}$"
If .test(TextBox1.Value) Then
Else
MsgBox "Ingrese una dirección de correo electrónico válida, No le aplique seguridad y privacidad para no bloquear la app", vbCritical, "Información ATex 3.0"
cancel = True
End If
End With
End If
End Sub
Private Sub TextBox2_Change()
End Sub
Private Sub userform_terminate()
Exit Sub
End SubEste es el código del userfrom
Adicional como evitar que salga en msgbox de correo enviado y evitar dar doble click para que continué con el siguiente
1 respuesta
Respuesta de Dante Amor
1