Hello Leith,
The error is within the piece below. It evens shows as it's publishing, but then the error window pops pup, saying that it's an object or application definition related error...
Thanks in advance for your attention/help!
Piece of Code reffered by the Debugger:
RelatorioComissao.Range("A1:K" & lastrow).ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=File, _
Quality:=xlQualityStandard, _
IgnorePrintAreas:=False
Sub SendGmailPDF()
Dim File As String
Dim Folder As Variant
Dim cdoNS As String
Dim cdoMsg As Object
Dim htmlMsg As String
Dim Password As String
Dim strBCC As String
Dim strCC As String
Dim strMsg As String
Dim strSubj As String
Dim strTo As String
Dim UserEmail As String
Dim RelatorioComissao As Worksheet
Dim LastRowResults As Range
Dim lastrow As Long
Dim Data As Date
Dim List As String
Dim Rng As Range
Set RelatorioComissao = ActiveWorkbook.Sheets("Relatório de Comissão")
Data = RelatorioComissao.Range("B8").Value
' Email Information.
strTo = RelatorioComissao.Range("B6").Value
strSubj = "Relatório de Comissão" & "-" & RelatorioComissao.Range("B5").Value & "-" & Format(Data, "mmm/yy")
strMsg = "Em anexo, segue o relatório de comissão. Sugerimos que revisem os detalhes."
strCC = ""
strBCC = ""
ReplyTo = "Email"
' Gmail Account Information.
UserEmail = RelatorioComissao.Range("B3").Value
Password = RelatorioComissao.Range("B4").Value
If UserEmail = "" Or Password = "" Then
MsgBox "Informe seu email e senha!"
Exit Sub
End If
File = "Relatório de Comissão" & RelatorioComissao.Range("B5").Value & "-" & Format(Data, "mmm/yy") & ".pdf"
If RelatorioComissao.Range("A17").Value = "" Then
lastrow = 16
MsgBox "Não há comissão no período!"
Exit Sub
Else
'lastrow = Cells(Rows.Count, "K").End(xlUp).Row
lastrow = Range("A" & ActiveSheet.Rows.Count).End(xlDown).Row
'lastrow = RelatorioComissao.Cells(Rows.Count, 1).End(xlUp).Row
End If
MsgBox lastrow
RelatorioComissao.Range("A1:K" & lastrow).ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=File, _
Quality:=xlQualityStandard, _
IgnorePrintAreas:=False
'ActiveSheet.Range("A1:K" & lastrow).Select
'Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=File, Quality:=xlQualityStandard, IgnorePrintAreas:=False
Set cdoMsg = CreateObject("CDO.Message")
With cdoMsg
.To = strTo
.Subject = strSubj
.From = UserEmail
.ReplyTo = ReplyTo
.CC = strCC
.BCC = strBCC
.TextBody = strMsg
.AddAttachment File
With .Configuration.Fields
.Item(cdoNS & "smtpusessl") = True ' Any non zero value is True
.Item(cdoNS & "smtpauthenticate") = 1 ' basic clear text
.Item(cdoNS & "sendusername") = UserEmail
.Item(cdoNS & "sendpassword") = Password
.Item(cdoNS & "smtpserver") = "smtp.gmail.com"
.Item(cdoNS & "sendusing") = 2 ' Using Port
.Item(cdoNS & "smtpserverport") = 465 ' Gmail SMTP Port
.Item(cdoNS & "smtpconnectiontimeout") = 60
.Update
End With
.Send
End With
End Sub