Enviar un rango de celdas de Excel a correo usando Gmail

Busco ayuda para generar una macro que me permita seleccionar un rango de celdas en Excel y enviarlas por correo usando gmail lo que llevo hasta el momento, después de varias consultas y experimentos, es lo de abajo, pero me marca un error y la verdad ya estoy atorado pues no se realmente mucho de macros, espero puedan ayudarme.

Sub CORREOS()
'Working in Excel 2000-2016
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object

Set Source = Nothing
On Error Resume Next
Set Source = Range("A1:K1000").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)

Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With

TempFilePath = Environ$("temp") & "\"
TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
FileExtStr = ".xlsx": FileFormatNum = 51
End If

Set MiCorreo = New CDO.Message
'
With MiCorreo.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'cdoBasic
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "antonio.arce.a@gmail"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxx"
.Update
End With
'
'Elementos del Correo
'
Whit MiCorreo
With MiCorreo
.Subject = Asunto
.From = "tucuentadegmail"
.To = ThisWorkbook.Sheets("DINAMICA").Range("B6").Value
'.CC = "[email protected]"
'.BCC = ""
.TextBody = "Adjunto Cargos del mes anterior"
.Attacments.Add Dest.FullName
'.HTMLBody = RangetoHTML(ActiveSheet.Range("A7:E10"))
End With
On Error GoTo 0
.Close savechanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
'
MiCorreo.Send
'MsgBox "El correo ha sido enviado."
'
Set MiCorreo = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Añade tu respuesta

Haz clic para o