Expertos agradeceré sus comentarios según esta macro
Siempre se ajunta un archivo a la vez a un correo, pero quien no adjunta mas de dos archivos a veces, yo he intentado de mil formas adjuntar todos los archivos de una carpeta a un correo y no he tenido éxito, se los planteo para ver si existe alguna forma de hacer esto median esta macro.-
Sub enviar()
Sheets("informe").Unprotect "2013"
Sheets("informe").Select
Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single
Dim OutApp As Object
Dim OutMail As Object
Dim ultFil As Long
Dim fec As String
fec = Format(Now, "dd-mmm-yyyy")
Application.DisplayAlerts = False
ActiveWindow.Zoom = 64 'Reduce la hoja para que la imagen quede ajustada al mail
With Range("b1:l26") 'Rango a guardar como imagen
Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height: .CopyPicture
End With
With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto)
.Chart.Paste
.Chart.Export "D:\control_" & fec & ".jpg" 'directorio en donde guarda la imagen
.Delete
End With
ActiveWindow.Zoom = 80 'Vuelve la hoja a su condición original
Application.DisplayAlerts = True
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.logon
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "xxxxxxx@xxxxxxxxxx"
.Subject = "Archivo"
With OutMail
On Error Resume Next
With OutMail
.Attachments.Add "D:\control_" & fec & ".jpg"
.BodyFormat = 2 'olFormatHTML
.HTMLBody = "<html>" & _
"<body>" & _
"<p>Señores:</p>" & _
"<p>Favor gestionar...</p>" & _
"<img src='cid:'" & .Attachments.Item(1).Filename & "' height=400 width=800>" & _
"</body>" & _
"</html>"
.display
.Attachments.Add "d:\informe\*.*"
.display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Sheets("informe").Protect "tes2013"
End With
End With
End Sub
