Con el siguiente código envías un archivo por gmail, el nombre del archivo deberá esta en la celda E2
Function SendMail_Gmail() As Boolean
'Dimensiono variables
Dim Email As CDO.Message
Dim Autentificion As Boolean
'Creo el objeto email
Set Email = New CDO.Message
'Ponemos datos del servidor a usar
Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
'Indicamos el número de puerto smtp
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
'Decimos si requiere o no autentificación 1 requiere, 0 no requiere
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
'Segundos de espera
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
'Definición de verdadero para la autentificación
Autentificacion = True
'Configuramos el ingreso al mail
If Autentificacion Then
'nombre de usuario
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "[email protected]"
'password
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "111111"
'si el servidor utiliza SSL (secure socket layer). en gmail: True
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End If
' Una vez configurado nuestro servidor de correo tomados datos de excel para enviar el mail
'Correo del destinatario
Email.To = Trim([a2].Value)
'Dirección del remitente
Email.From = Trim([b2].Value)
' Asunto
Email.Subject = Trim([c2].Value)
' Mensaje
Email.TextBody = Trim([d2].Value)
'Path del archivo attach
If [a2].Value <> vbNullString Then
Email.AddAttachment (Trim([e2].Value))
End If
'Actualizamos datos antes del envio
Email.Configuration.Fields.Update
'Controlo errores
On Error Resume Next
'enviamos propiamente el mail
Email.Send
'Si no hay errores la funcion es verdadero
If Err.Number = 0 Then
SendMail_Gmail = True
Else
'Sale msgbox con descripción del error
MsgBox "Se produjo el siguiente error: " & Err.Description, vbCritical, "Error nro " & Err.Number
End If
'Borro los objetos
If Not Email Is Nothing Then
Set Email = Nothing
End If
'Controlo errores
On Error GoTo 0
End Function
'Código que se agrega en un módulo
Sub SendMail()
Dim fila As String
Dim Exito As Boolean
'Evito movimientos de la pantalla
Application.ScreenUpdating = False
fila = 2
'Bucle en caso de haber listado de direcciones de correo
While Sheets("dire").Cells(fila, 1) <> Empty
'Si queremos enviar un solo mail va esta parte solamente
'Dim Exito As Boolean
'llamo a la funcion:
Exito = SendMail_Gmail()
'Si es verdadero, es decir el mail se envio
If Exito = True Then
MsgBox "El mail se envió con éxito", vbInformation, "Informe"
End If
fila = fila + 1
Wend
Application.ScreenUpdating = True
End Sub
Para guardar una hoja en un libro y posteriormente enviarla como archivo puedes utilizar lo siguiente:
Sub Macro4()
'Guardar una hoja y poner el nombre en la celda E2
'por.dam
wpath = ThisWorkbook.Path & "\"
Sheets("Hoja2").Select
nombre = ActiveSheet.Name
Sheets("Hoja2").Copy
ActiveWorkbook.SaveAs Filename:=wpath & nombre & ".xls", _
ActiveWorkbook.Close
Range("E2") = wpath & nombre & ".xls"
End sub
Revísalo y me comentas
Saludos. Dam
Si es lo que necesitas.