Sub Remindermail()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList, CCList As String
Dim eSubject As String
Dim eBody As String
Dim OutApp As Object, _
OutMail As Object
Dim Signature As String
Dim sPath As String
Dim S As String
Dim sht As Worksheet
Dim rng As Range
Dim sh As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
Set sht = Sheets("Master data")
Set sh = Sheets("Data")
Set rng = Nothing
' Only send the visible cells in the selection.
Set rng = sh.Range("C2:D3").SpecialCells(xlCellTypeVisible)
If rng Is Nothing Then
MsgBox "An unknown error has occurred. "
Exit Sub
End If
'On Error GoTo err_exit
With sht
lRow = .Cells(.Rows.Count, 4).End(xlUp).Row
Set OutApp = CreateObject("Outlook.Application")
'S = Environ("appdata") & "\Microsoft\Signatures\"
'If Dir(S, vbDirectory) <> vbNullString Then S = S & Dir$(S & "*.htm") Else S = ""
'S = CreateObject("Scripting.FileSystemObject").GetFile(S).OpenAsTextStream(1, -2).ReadAll
For i = 4 To lRow
If Cells(i, 5).Value <= 100 And Cells(i, 23).Value = "" And Cells(i, 23).Value < 30 Or _
.Cells(i, 6).Value <= 100 And Cells(i, 23).Value = "" And Cells(i, 23).Value < 30 Or _
.Cells(i, 7).Value <= 250 And Cells(i, 23).Value = "" And Cells(i, 23).Value < 30 Or _
.Cells(i, 24).Value <= 50 And Cells(i, 23).Value = "" And Cells(i, 23).Value < 30 Or _
.Cells(i, 10).Value <= 250 And Cells(i, 23).Value = "" And Cells(i, 23).Value < 30 Or _
.Cells(i, 20).Value <= 50 And Cells(i, 23).Value = "" And Cells(i, 23).Value < 30 Or _
.Cells(i, 20).Value >= 50 And .Cells(i, 20).Value <= 100 And Cells(i, 23).Value = "" And Cells(i, 23).Value < 30 Or _
.Cells(i, 20).Value >= 200 And .Cells(i, 20).Value <= 250 And Cells(i, 23).Value = "" And Cells(i, 23).Value < 30 Then
Set OutMail = OutApp.CreateItem(0)
If Cells(i, 21).Value = "" Then
Range("U" & i).Value = "Mail Sent on"
Range("V" & i).Value = Format(Now, "YYYY-MM-DD")
End If
toList = .Cells(i, 26)
'CCList = Worksheets("Data").Cells(7, 3) & "; " & Worksheets("Data").Cells(8, 3) _
& "; " & Worksheets("Data").Cells(9, 3) & "; " & Worksheets("Data").Cells(10, 3) _
& "; " & Worksheets("Data").Cells(11, 3)
If .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Engine / Transmission / Axle & Hydraulic] Service"
ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 Then
eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Engine / Transmission & Axle] Service"
ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 And .Cells(i, 10).Value <= 250 Then
eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Engine / Transmission & Hydraulic] Service"
ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 7).Value <= 250 Then
eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Engine & Axle] Service"
ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 Then
eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Engine & Transmission] Service"
ElseIf .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Transmission / Axle & Hydraulic] Service"
ElseIf .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 Then
eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Transmission & Axle] Service"
ElseIf .Cells(i, 6).Value <= 100 And .Cells(i, 10).Value <= 250 Then
eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Transmission & Hydraulic] Service"
ElseIf .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Axle & Hydraulic] Service"
ElseIf .Cells(i, 5).Value <= 100 Then
eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Engine] Service"
ElseIf .Cells(i, 6).Value <= 100 Then
eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Transmission] Service"
ElseIf .Cells(i, 7).Value <= 250 Then
eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Axle] Service"
ElseIf .Cells(i, 10).Value <= 250 Then
eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Hydraulic] Service"
ElseIf .Cells(i, 20).Value >= 0 And .Cells(i, 20).Value < 50 Then
eSubject = "Reminder for your " & .Cells(i, 3) & " Machine Engine First Oil Service"
ElseIf .Cells(i, 20).Value > 50 And .Cells(i, 20).Value < 100 Then
eSubject = "Reminder for your " & .Cells(i, 3) & " Machine Transmission First Oil Service"
ElseIf .Cells(i, 20).Value > 100 And .Cells(i, 20).Value < 250 Then
eSubject = "Reminder for your " & .Cells(i, 3) & " Machine Axle First Oil Service"
End If
eBody = "<p style='font-family:Cambria;font-size: 12pt'>" & "Dear Sir, <br><br>" _
& "Greetings from " & "<b> SCHWING STETTER! </b><br><br>" _
& " We hope you're doing well.<br><br>" _
& " We wanted to inform you that your " & "<b>" & Cells(i, "C").Value & "</b>" _
& " Machine (Sr.No: " & "<b>" & Cells(i, "D") & "</b>" _
& ") reached " & "<b>" & .Cells(i, "T").Value & "</b>" & "hrs and due for next oil service.<br><br>" _
& " So kindly arrange the consumables as per the attachment.<br><br>" _
& " We truly care about your well-being, so if you have any questions or needs in advance of your appointment, you are welcome to call us anytime," & RangetoHTML(rng) & "<br><br>" & "</p>"
'Print '************************************************* ********
'Turns off screen updating
Application.ScreenUpdating = False
'Makes a copy of the active sheet and save it to a temporary file
Dim wks As Worksheet
mySheet = Worksheets("Master data").Cells(i, "C").Value
TempFilePath = Environ$("temp") & "\"
'TempFileName = mySheet & "Service details.pdf"
If .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
TempFileName = mySheet & " Machine Engine / Transmission / Axle & Hydraulic Service Spares.pdf"
ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 Then
TempFileName = mySheet & " Machine Engine / Transmission & Axle Service Spares.pdf"
ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 And .Cells(i, 10).Value <= 250 Then
TempFileName = mySheet & " Machine Engine / Transmission & Hydraulic Service Spares.pdf"
ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
TempFileName = mySheet & " Machine Engine / Axle & Hydraulic Service Spares.pdf"
ElseIf .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
TempFileName = mySheet & " Machine Transmission / Axle & Hydraulic Service Spares.pdf"
ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 7).Value <= 250 Then
TempFileName = mySheet & " Machine Engine & Axle Service Spares.pdf"
ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 Then
TempFileName = mySheet & " Machine Engine & Transmission Service Spares.pdf"
ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 10).Value <= 250 Then
TempFileName = mySheet & " Machine Engine & Hydraulic Service Spares.pdf"
ElseIf .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 Then
TempFileName = mySheet & " Machine Transmission & Axle Service Spares.pdf"
ElseIf .Cells(i, 6).Value <= 100 And .Cells(i, 10).Value <= 250 Then
TempFileName = mySheet & " Machine Transmission & Hydraulic Service Spares.pdf"
ElseIf .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
TempFileName = mySheet & " Machine Axle & Hydraulic Service Spares.pdf"
ElseIf .Cells(i, 5).Value <= 100 Then
TempFileName = mySheet & " Machine Engine Service Spares.pdf"
ElseIf .Cells(i, 6).Value <= 100 Then
TempFileName = mySheet & " Machine Transmission Service Spares.pdf"
ElseIf .Cells(i, 7).Value <= 250 Then
TempFileName = mySheet & " Machine Axle Service Spares.pdf"
ElseIf .Cells(i, 10).Value <= 250 Then
TempFileName = mySheet & " Machine Hydraulic Service Spares.pdf"
ElseIf .Cells(i, 20).Value > 0 And .Cells(i, 20).Value < 50 Then
TempFileName = mySheet & " Machine First Engine Oil Service Spares.pdf"
ElseIf .Cells(i, 20).Value > 50 And .Cells(i, 20).Value < 100 Then
TempFileName = mySheet & " Machine First Transmission Oil Service Spares.pdf"
ElseIf .Cells(i, 20).Value > 200 And .Cells(i, 20).Value < 250 Then
TempFileName = mySheet & " Machine First Axle Oil Service Spares.pdf"
End If
'FileFullPath = TempFilePath & TempFileName
FileFullPath = TempFileName
Set MR = Cells(i, "C")
If .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
Worksheets(mySheet).Range("B879:F934").ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 Then
Worksheets(mySheet).Range("B649:F699").ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 And .Cells(i, 10).Value <= 250 Then
Worksheets(mySheet).Range("B705:F758").ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
Worksheets(mySheet).Range("B763:F815").ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ElseIf .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
Worksheets(mySheet).Range("B820:F870").ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 7).Value <= 250 Then
Worksheets(mySheet).Range("B389:F436").ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 Then
Worksheets(mySheet).Range("B336:F385").ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 10).Value <= 250 Then
Worksheets(mySheet).Range("B443:F493").ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ElseIf .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 Then
Worksheets(mySheet).Range("B495:F540").ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ElseIf .Cells(i, 6).Value <= 100 And .Cells(i, 10).Value <= 250 Then
Worksheets(mySheet).Range("B542:F592").ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ElseIf .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
Worksheets(mySheet).Range("B598:F645").ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ElseIf .Cells(i, 5).Value <= 100 Then
Worksheets(mySheet).Range("B145:F191").ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ElseIf .Cells(i, 6).Value <= 100 Then
Worksheets(mySheet).Range("B193:F236").ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ElseIf .Cells(i, 7).Value <= 250 Then
Worksheets(mySheet).Range("B240:F283").ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ElseIf .Cells(i, 10).Value <= 250 Then
Worksheets(mySheet).Range("B287:F333").ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ElseIf .Cells(i, 20).Value > 0 And .Cells(i, 20).Value < 50 Then
Worksheets(mySheet).Range("B2:F46").ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ElseIf .Cells(i, 20).Value > 50 And .Cells(i, 20).Value < 100 Then
Worksheets(mySheet).Range("B49:F93").ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ElseIf .Cells(i, 20).Value > 200 And .Cells(i, 20).Value < 250 Then
Worksheets(mySheet).Range("B97:F140").ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
On Error Resume Next
With OutMail
.To = toList
.CC = CCList
.BCC = ""
.Subject = eSubject
.HTMLBody = eBody
.display
.Attachments.Add FileFullPath
'.Send
End With
On Error GoTo 0
End If
Next i
End With
Set OutApp = Nothing
ActiveWorkbook.Save
err_exit:
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
'Sheets("Master data").Range("A1").Select
End Sub
Function RangetoHTML(rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
FileName:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
Can any one help me why i am getting this error message.