Visual Basic - Enviar mail

Life is soft - evento anual de software empresarial
 
Vista:
sin imagen de perfil
Val: 13
Ha disminuido su posición en 4 puestos en Visual Basic (en relación al último mes)
Gráfica de Visual Basic

Enviar mail

Publicado por Cristhian (6 intervenciones) el 24/05/2019 20:31:30
Hola que tal a todos?
Les escribo para solicitar su ayuda con un problema que tengo para enviar un correo a un destinatario X.
Les explico un poco como va el tema.
Resulta que hice una planilla de calculo tipo factura, la cual tengo que guardar en un nuevo archivo y enviar por correo, hasta ahí todo bien, tengo el código que hace esas dos cosas (por separado). Mi dilema esta, en que ahora me pidieron que al momento enviar el correo, se haga automáticamente, es decir, según el cliente que estoy procesando debe enviarse el correo.
Me explico: si estoy procesado calculando los datos de Juanito Perez Ltda. quiero que el correo se envié a [email protected] y así según vaya cambiando el cliente.
Tengo la planilla con los correos y los clientes, me falta hacer la consulta que llame al destinatario.
En mi hoja de calculo obtengo los datos Rut, serie, y nombre de cliente, me imagino que con uno de esos campos puedo invocar el correo correspondiente.

Adjunto código para convertir archivo en PDF y enviar por correo:

Sub GuardaryEnviar()
Dim Hoja As Worksheet
Dim Archivo As FileDialog
Dim Carpeta As String
Dim Siono As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range
Dim nombre As String
Dim Hoy As Date
Dim mes As String

nombre = Range("E61").Value
Hoy = DateTime.Now
mes = MonthName(Month(Hoy))

Set Hoja = ActiveSheet
Set Archivo = Application.FileDialog(msoFileDialogFolderPicker)

If Archivo.Show = True Then
Carpeta = Archivo.SelectedItems(1)
Else
MsgBox "Debe especificar una carpeta para guardar el PDF en." _
& vbCrLf & vbCrLf & "Presiona OK para salir de esta macro.", _
vbCritical, "Debe especificar la carpeta de destino"
Exit Sub
End If
Carpeta = "C:\Facturacion\" & mes & "\" & nombre & ".pdf"
'Compruebo si el archivo ya existe
If Len(Dir(Carpeta)) > 0 Then
Siono = MsgBox(Carpeta & " Ya existe." & vbCrLf & vbCrLf & "Quiere sobreescribirlo?", _
vbYesNo + vbQuestion, "El archivo existe")
On Error Resume Next
If Siono = vbYes Then
Kill Carpeta
Else
MsgBox "Si no sobrescribe el PDF existente, no puede continuar." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
Exit Sub
End If
If Err.Number <> 0 Then
MsgBox "No se puede eliminar el archivo existente. Asegúrese de que el archivo no esté abierto o protegido contra escritura." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "No se puede eliminar el archivo"
Exit Sub
End If
End If

Set xUsedRng = Hoja.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Guardar como archivo PDF
Hoja.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Carpeta, Quality:=xlQualityStandard
'Crear correo
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmailObj = xOutlookObj.createitem(0)
With xEmailObj
.display
.to = ""
.CC = "[email protected]; [email protected]; [email protected]"
.Subject = "Factura " & Range("E61").Value
.Attachments.Add Carpeta
.htmlbody = sbdy
.Body = "Estimados:" _
& vbCrLf & vbCrLf & "Adjunto factura " _
& Range("E61").Value & " correspondiente al mes de " & mes & "." _
& vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf _
& vbCrLf & "Saluda Atte." & vbCrLf _
& "Importadora y Exportadora Nueva Atlanta Ltda." _
& vbCrLf & "Fonos: 452213376 - 452234410" & vbCrLf _
& "E -MAIL: [email protected]" _
& vbCrLf & "Web: http://nuevaatlanta.cl/"
End With
Else
MsgBox "La hoja de trabajo activa no puede estar en blanco"
Exit Sub
End If
End Sub


Ojala puedan ayudarme.
de ante mano muchas gracias.

Atte.
Cristhian
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder