hellfire45
Active Member
- Joined
- Jun 7, 2014
- Messages
- 462
Can anybody please explain why this is happening? I will bold the line where the error occurs. Thank you so much!
Code:
Sub SendReport_loop()
Dim wb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim PromoSheet As String
Dim SigString As String
Dim Signature As String
Dim strPath As String
Dim objOutlookMsg As Object
Dim rng As Range
Dim rebateval As String
Dim strbody As String
Dim ship_table_header As Integer
Dim ship_table_emails As Integer
Dim ship_Table_End As Integer
Dim i As Integer
Dim srcpath As String
Dim reportfolder As String
Dim reportname As String
Dim xlist As Integer
FileExtStr = ".xls"
FileFormatNum = xlExcel8
ship_table_header = Application.Match("Account", Sheet12.Columns(1), 0)
ship_table_emails = Application.Match("Emails", Sheet12.Rows(ship_table_header), 0)
ship_Table_End = Sheet12.Columns(1).Find("*", , xlValues, , xlRows, xlPrevious).Row
i = 0
srcpath = "I:\EndDevTools\Lenovo\Lenovo Retail\CPFR Automation\Lenovo Huge CPFR File\"
Do 'This loop will find the most recent report within the last month
If Dir(srcpath & Format(Date - i, "mm-dd-yyyy"), vbDirectory) <> "" Then
reportfolder = srcpath & Format(Date - i, "mm-dd-yyyy") & "\"
Exit Do
Else
i = i + 1
End If
Loop Until i = 35
For xlist = ship_table_header + 1 To ship_Table_End
Application.StatusBar = "Processing Customer Sheet " & ship_table_header - (ship_table_header - 1) & " of " & ship_Table_End - (ship_table_header - 1)
reportname = reportfolder & Sheet12.Cells(xlist, 1).value & Format(Date - i, "yyyy-mm-dd") & ".xlsx"
Set wb = ActiveWorkbook
strbody = "<HTML>******>"
strbody = strbody & "<font face =""Calibri"" size=""3"">" & "Good Day," & "<br>" & "<br>" _
& "Please see the attached " & Sheet12.Cells(xlist, 4).value & " CPFR Data Sheet for the week of " & Format(Date, "mm.dd.yy") & "." & " Please let me know if you have any questions." & "<br>" & "<br>"
strbody = strbody & "</BODY></HTML>"
Set OutApp = CreateObject("Outlook.Application")
[B] Set objOutlookMsg = OutApp.CreateItem(olMailItem)[/B]
Set objOutlookMsg = OutApp.CreateItem(0)
With objOutlookMsg
.Display
End With
Signature = objOutlookMsg.Body
With wb
With objOutlookMsg
.To = Sheet12.Cells(xlist, ship_table_emails).value
' .CC = Sheets("DistiList").Range("B7").value
' .BCC = Sheets("DistiList").Range("B8").value
.Subject = "CPFR Data Sheet - " & Sheet12.Cells(xlist, 4).value & " - " & Format(Date - i, "mm-dd-yyyy")
.HTMLBody = strbody & objOutlookMsg.HTMLBody
.Attachments.Add (reportname)
.Send
End With
End With
Next xlist
End Sub
