Enviar email desde excel vba a cuenta en google apps

Favor si me puedes ayudar con un inconveniente que tengo con una macro:

Tengo una macro donde realizo varios procesos, cuando ya he acomodado los datos necesarios, estos a través de un botón los envío al mail configurado en Microsoft Outlook con la siguiente linea:

Applications.Dialogs(xldialogSendMail).show [email protected] ...

Abre automáticamente un nuevo correo con el destinatario y el archivo adjunto.

Pero necesito que se pudiera abrir de la misma forma pero con una cuenta en google apps, solo e podido abrir la pagina y la ventana de enviar:

Dim chromePath As String
chromePath = """C:\Program Files\Google\Chrome\Application\chrome.exe"""
Shell (chromePath & "-url https://mail.google.com/mail/?tab=mm#inbox/13e23b6a7da7dd31?compose=new")

Pero no e podido al momento de abrir la ventana de enviar me adjunte automáticamente la hoja a enviar y el mail de destinatario.

Favor si me pueden colaborar con ese asunto que no e podido terminar

1 Respuesta

Respuesta
1

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.

hola aprendemos...

gracias por tu rápida respuesta,

este código es una forma muy buena para lo que necesito...solo 2 cosas:

en el user y pass de la cuenta d gmail...hay alguna forma de q no halla necesidad de poner estos datos?...es decir la cuenta mantendría abierta sin necesidad d ingresar estos datos...te lo digo sobre todo xq se enviarían de otras cuentas a un solo destinatario..no se si esto sea posible.

y la parte del attachment hago tal cual tus indicaciones pero no envía el adjunto

La parte de enviar archivo puede ser por versiones de sistemas o por el servidor.

Lo del user y pass los puedes poner en unas celdas y puedes ocultar la hoja o protegerla.

Sigue buscando en google algo como esto

Cdo email ron de bruin, por ejemplo

http://dailydoseofexcel.com/archives/2007/06/24/sending-mail-from-excel-with-cdo/

Saludos. Dam

muchas gracias aprendemos,

haré lo de los usuarios en una hoja protegida, lo del adjunto debo trabajarlo muy bien, pero igual, las propuestas fueron de mucha ayuda.

Muchas gracias !

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas