Envío de una selección de celdas por correo electrónico
maya
-
fabidou49 -
fabidou49 -
Hola,
Tengo Excel 2010 una hoja de cálculo con columnas de "A" a "BC" y filas de "1" a "100", y quisiera enviar por correo únicamente la selección siguiente: $A$3:$AA$55. Si uso la opción definir área de impresión y envío el archivo por correo, el destinatario recibe toda la hoja en lugar de la selección. Soy novato en VBA, ¿alguien podría compartir un código para hacer esto desde un botón?
Gracias de antemano
Configuración: Windows 7 / Internet Explorer 9.0
Tengo Excel 2010 una hoja de cálculo con columnas de "A" a "BC" y filas de "1" a "100", y quisiera enviar por correo únicamente la selección siguiente: $A$3:$AA$55. Si uso la opción definir área de impresión y envío el archivo por correo, el destinatario recibe toda la hoja en lugar de la selección. Soy novato en VBA, ¿alguien podría compartir un código para hacer esto desde un botón?
Gracias de antemano
Configuración: Windows 7 / Internet Explorer 9.0
27 respuestas
- 1
- 2
Siguiente
-
Hola Mike_31
gracias por tu respuesta
mi pestaña se llama "FORMULARIO"
de hecho este libro contiene un modelo para las personas que deben llenarlo, y no me envíe por correo solo la parte rellenada. -
Hola,
no es un problema, puedes enviar el rango que desees sin pasar por tu correo, directamente en CDO.
Pero con un código VBA hay que ser preciso. Quieres enviar el rango $A$3 :$AA$55 pero ¿de qué hoja, la hoja activa o cuál y cómo se llama?
¿y en extensión XLS, XLSX o en PDF, lo cual ofrece más seguridad y limita los problemas relacionados con la posesión de Excel y sus versiones?
Saluditos
Mike-31
Una época de fracaso es un momento perfecto para sembrar las semillas del saber. -
Hola,
No te olvido, te hago un ejemplo: envío en PDF y XLS en la noche
--
A+
Mike-31
Un periodo de fracaso es un momento soñado para sembrar las semillas del conocimiento. -
Hola,
prueba este archivo
https://www.cjoint.com/?BJsxn5JSAcU
--
Nos vemos
Mike-31
Un periodo de fracaso es un momento perfecto para sembrar las semillas del saber.-
Buenas noches a todos,
hola mike,
He querido mirar tu archivo. En 2003 tengo 'variable desconocida' para xlExcel8 en:
ActiveWorkbook.SaveAs camino & "\" & nombre, FileFormat:=xlExcel8
En 2003, en la serie de xlExcelx solo tenemos:
xlExcel2
xlExcel3
xlExcel4Workbook
xlExcel5
xlExcel7
xlExcel9795
Buenas noches
eric -
-
-
Hola,
Lo escribí en Excel 2007 y funciona perfectamente.
Tras la observación de Eriiic, a quien saludo, reviso el código para probar las versiones de Excel.
Publicaré un archivo a primera hora de la tarde para que puedas probarlo en Excel 2010 y Eriiic en 2003
--
Nos vemos
Mike-31
Un periodo de fracaso es un momento soñado para sembrar las semillas del saber. -
Hola,
Al inicio del código, indicar las constantes: destinatario, SMPT y, si procede, dirección del remitente.
Const Dest As Variant = "wwwwwwwwwww@free.fr"
Const C_Ent As Variant = "SMTP.free.fr"
Const Exped As Variant = "www.xxxxxxx@free.fr"
https://www.cjoint.com/?BJtl3GkxOPr
--
Saludos,
Mike-31
Una época de fracaso es un momento perfecto para sembrar las semillas del saber.-
-
Hola,
Espera un poco, no he revisado el código en detalle, seguramente hay posibilidad de aligerarlo; lo revisaré esta noche.
Sería interesante que un suizo que esté atento lo pruebe y comparta sus observaciones, a ciertos proveedores de acceso les pide autenticación, en ese caso hay que añadir dos líneas al código.
El envío en CDO es interesante ya que no utiliza ningún correo y desde que Microsoft ya no proporciona Outlook en su suite familiar es una solución y además versátil
Saludos -
-
-
RE.
Bueno, chicos, y bien el problema soy yo...
Mensaje en ejecución
« Microsoft Excel
El mensaje no pudo enviarse al servidor SMTP. El código de error de transporte era 0x80040217. La respuesta del servidor era not available. »
sin abusar, ¿hay posibilidad de abrir directamente Outlook
@+ maya -
Hola,
Te comento que el código ha evolucionado gracias a los intercambios con Eriiic y, a la vez, resuelve tus problemas.
Por mi parte hace tiempo que abandoné Outlook
¿Has configurado correctamente las constantes al inicio del código (dirección de correo, smtp)?
¿Quién es tu proveedor de Internet?
Nos vemos
Mike-31
Un periodo de fracaso es un momento propicio para sembrar las semillas del saber. -
sí, he ingresado correctamente las direcciones de correo y el smtp, mi proveedor de acceso es Orange
gracias de todas formas
@+ -
Re,
¿Esta constante la entendiste así, con las comillas?
Const C_Ent As Variant = "SMTP.orange.fr"
A+
Mike-31
Un periodo de fallos es un momento soñado para sembrar las semillas del saber. -
-
Hola,
¿utilizas bien mi archivo de ejemplo en el que has ingresado la dirección de correo y el SMTP?
Const Dest As Variant = "wwwwwwwwwww@free.fr"
Const C_Ent As Variant = "SMTP.orange.fr"
--
A+
Mike-31
Una época de fracaso es un momento ideal para sembrar las semillas del conocimiento. -
re
sí, lo he guardado en mi disco duro, he reemplazado lo que dice m(a) respetando mayúsculas y minúsculas
ahora en Outlook tengo informaciones de usuario: con un usuario con una contraseña para la conexión al servidor de Orange (Oleane VPN)
@+ -
Hola,
Extraño porque este procedimiento no usa ningún correo, salimos directamente con el proveedor de acceso.
sin embargo, si quieres usar Outlook tengo códigos que no puedo probar
arranca de nuevo tu ordenador para ver.
Nos vemos
Mike-31
Un periodo de fallo es un momento soñado para sembrar las semillas del saber. -
Hola,
Acabo de volver a probar de forma más completa (en Orange) y está bien.
A señalar que hay que completar/modificar estas líneas:
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = ""
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = ""
Mike, podrías subirlas (y las 3 restantes) como constantes en la parte superior del código.
¿Tal vez convenga dejar separados Exped y sendusername? (por si se usa el smtp de otro operador)
Parámetros para Oléane:
smtp por: smtp.msa.orange-business.com
puerto smtp: 587
De lo contrario, queda la posibilidad de usar el smtp de otro operador, poniendo su verdadera dirección de correo para la respuesta.
Quise probar con Gmail (SMTP.gmail.com, puerto 587) pero me lo bloquean:
"...Must issue STARTTLS command first..."
Mike, si has visto cómo activar ese TLS en tus andanzas (?)
eric
PD: de paso encontré esto que podría servir:
The reply email address : .item(http://schemas.microsoft.com/cdo/configuration/senduserreplyemailaddress) = ""
Jamás responderás a un mp no solicitado...
Bueno, ya está hecho. -
al introducir los parámetros de la cuenta en duro funciona
Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxxxx@xxxxxxxxxxx"
Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "yyyyyyy"
gracias a ambos, que pasen un buen fin de semana. -
Hola,
estas dos líneas gestionan las autenticaciones de conexión
esta línea
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Nombre de usuario del correo"
esta línea
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "contraseña"
eso se relaciona con mi pregunta sobre las conexiones seguras, especialmente en Suiza o en ciertos servidores
En caso contrario, estas dos líneas pueden eliminarse
Para responder a Eriiic sí, podemos elevar todo a constantes; eso facilita las modificaciones, por eso decía que esperáramos para que pudiera encontrar tiempo para completar el código.
la línea que propones
.item(http://schemas.microsoft.com/cdo/configuration/senduserreplyemailaddress) = ""
en realidad la olvidé, la traté como constante y no la ubiqué en la serie de Items
Const Exped As Variant = "www.xxxxxxx@free.fr" '----- dirección de correo del remitente
Error de mi parte, hubiera sido una lástima que faltara en el código Gracias por este comentario
He propuesto este código varias veces en este foro que es posible encontrar, pero doy por resuelta esta discusión para que sirva de referencia; en los próximos días haré una pequeña truco
Nos vemos
Mike-31
Un periodo de fracaso es un momento soñado para sembrar las semillas del saber. -
Hola,
aquí tienes el código completo anotado
Option Explicit
Sub Envoi_Mail ()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb, Destwb As Workbook
Dim TempFilePath, TempFileName As String
Dim Wb, iMsg, iConf As Object
Dim Flds As Variant
'--------------------------- Constante à renseigner
Constante Feuille As Variant = "FORMULAIRE" '------------- nom de la feuille à copier
Const Plage As Variant = "A1:H10" '------------------- plage à copier
Const Dest As Variant = "michel.wwwwwwwwww@free.fr" '- adresse mail du destinataire
Const Exped As Variant = "www.xxxxxxx@free.fr" '------ adresse mail de réponse de l'expéditeur
Const C_Ent As Variant = "SMTP.free.fr" '------------- adresse du SMTP"
Const CC As Variant = "" '---------------------------- adresse mail CC
Const BCC As Variant = "" '--------------------------- adresse mail destinataire pour envoi BCC ou BCI ou CCI
Const NumPort As Variant = 25 '----------------------- n° port du serveur sortant
'--------------------------- Si la connexion nécessite une authentification
Const N_Messag As Variant = "Nom utilisateur messagerie"
Const Pass As Variant = "motdepasse"
On Error GoTo errorHandler
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
Set Destwb = Workbooks.Add
Sourcewb.Sheets(Feuille).Range(Plage).Copy Destwb.ActiveSheet.Range("A1")
'--------------------------- Déterminer la version d'Excel et d'extension du fichier utilisé
With Destwb
If Val(Application.Version) < 12 Then
'--------------------------- Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'--------------------------- Excel 2007-2010
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Votre réponse est NON dans la boîte de dialogue de sécurité"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With
TempFilePath = Environ$("temp") & "\"
'-------------------------- Nom du classeur expédié avec jour et heure d'envoi
TempFileName = Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
.Close savechanges:=False
End With
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 '--------- CDO Source Default
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = C_Ent '"smtp.free.fr" '"Saisir le SMTP du serveur sortant"
.Item("http://schemas.microsoft.com/cdo/configuration/senduserreplyemailaddress") = Exped '"adresse email de réponse expéditeur"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = NumPort '25 'n° port du serveur sortant
'--------------------------- Si la connexion nécessite une authentification libérer les 3 lignes
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
'ou
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
' .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = N_Messag 'ou "Nom utilisateur messagerie"
' .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Pass 'ou "motdepasse"
.Update
End With
With iMsg
Set .Configuration = iConf
.To = Dest
.CC = CC
.BCC = BCC
.From = Exped
.Subject = [C1].Value
.TextBody = "Bonjour" & " " & [C2].Value & "," & vbCrLf & vbCrLf _
& "Veuillez trouvez ci-joint le " & [C3].Value & "." & vbCrLf & vbCrLf _
& [C4].Value & vbCrLf _
& [C5].Value & vbCrLf _
& [C6].Value & vbCrLf _
& [C7].Value & vbCrLf _
& [C8].Value & vbCrLf _
& [C9].Value & vbCrLf _
& [C10].Value & vbCrLf & vbCrLf _
& [C11]
.AddAttachment TempFilePath & TempFileName & FileExtStr
.Send
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Le mail a été bien envoyé !" '---------- Confirmation de l'envoi
Exit Sub
'--------------------------- Si erreur on sort de la procédure
errorHandler:
'--------------------------- Description de l'erreur survenue
MsgBox Err.Description
'--------------------------- Si erreur ferme la copie temporaire
For Each Wb In Workbooks
If Left(Wb.Name, 1) <> "Claseur" And Wb.Name <> ThisWorkbook.Name Then
Wb.Close
End If
Next Wb
End Sub
A+
Mike-31
Une période d'échec est un moment rêvé pour semer les graines du savoir.-
Hola,
no tengo tiempo esta noche pero mañana intentaré encontrar tiempo para probar con una cuenta de Gmail que pide algo más: activar el TSL (?)
Por cierto me gusta la precisión ;-)
Si en el comentario de Const Exped puedes poner:
dirección de correo de respuesta del remitente
Y publica aquí cuando hayas redactado el truco, por favor.
Buenas noches
eric -
-
Buenas noches Mike, Oupsss, se me había olvidado.. Bueno, después de algunas investigaciones, el CDO no reconoce TSL, pero Gmail también trabaja con SSL en el puerto 465. Y ahí bingo con: servidor smtp: SMTP.gmail.com smtpserverport = 465 y añadir:
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = TrueDejar en false para los otros proveedores que no trabajan con SSL. Me imagino, además, una pequeña constante al principio: smtpusessl = False ;-) con un pequeño comentario diciendo que poner en true para los servidores de Gmail (Hotmail también apparently, pero no tengo cuenta para probar) A+ Eric
-
-
Hola,
He agregado de respuesta
también pensé, si la selección a copiar contiene enlaces con celdas fuera de la selección o en otra hoja
habrá que reemplazar esta línea
Sourcewb.Sheets(Feuille).Range(Plage).Copy Destwb.ActiveSheet.Range("A1")
que se puede escribir
Sourcewb.Sheets(Feuille).Range(Plage).Copy Destwb.ActiveSheet.[A1]
por, para pegar únicamente los valores
Sourcewb.Sheets(Feuille).Range(Plage).Copy
Destwb.ActiveSheet.[A1].PasteSpecial Paste:=xlPasteValues
eventualmente añadir esta línea si se quiere pegar los formatos
Destwb.ActiveSheet.[A1].PasteSpecial Paste:=xlPasteFormats
y añadir esta línea para desactivar la máscara del pegado, más agradable a la recepción
Destwb.ActiveSheet.[A1].Select
Saludos
Mike-31
Un periodo de fracaso es un momento soñado para sembrar las semillas del saber. -
Hola chicos, espero que hayan pasado un buen fin de semana;
después de todas las modificaciones funciona, a un detalle cerca es que la copia no respeta el formato, ¿hay alguna posibilidad de corregirlo?
@+ y gracias de nuevo
maya
- 1
- 2
Siguiente