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 Sub
Este 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