elsuji
09-12-2020, 01:36 PM
Dear Team,
I wrote code for sending mail with pdf attachment. When i am running my code i am getting following error message
http://www.vbaexpress.com/forum/image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAW8AAADLCAYAAAChxhJYAAAd2ElEQVR4Ae2dX7Ij t3XGuY1ZgizLLrsqtHWtkl2WZFeUVBLNSFbZiRImHl XrPyZXfB1lqB3vmsZdwN61AbuDjp10DjoAxDobnazSYL9mypOd6OBg4PvfPhwGuQlN2/evGl4gQEcgANwoC4ObCRg/AMBEAABEKgHAdFtxLueeOEpCIAACDgEEG IAAIgAAIVIoB4Vxg0XAYBEAABxBsOgAAIgECFCCDeFQYNl0EABEAA8YYDIAACIFAhAgXx/q553GyazeN32SF9//ah2WwemrffN03z/dvmQc ztS9Q N1jsxF/H9424lLp33ePm bBOW1qSFsZ5yLjEBw9TqbLpvH4is/ VYA6anV0sYjPR71QAAIgcIMI9Ij3Q/Pw0Cc8uXvXGGErhJ34lQSzaRoVauOmCHrX1tw4y2nJl6TcifBjk18qz IIRkAABO4MgV7xfnx8KGSqj4WM8hroJELostrCwnIkktJ2SdFMfVN80vL0WutxBAEQAIE8Ar3i/fb7VNy b966bNyKjT2XTqROuh3Q1pHFYKNi6YQ0rVdqr9szaX2x25U9vH0bXR9v 7S hUw7ysTtOMpj6HZdbH1J6js/un7jOl0IkvLIj5KtMT7l6nS9cgYCIHA/CAyIdyskQexEcN2 shUfe96Kx9G st/j7cqljdmucELus VEyFqoe ofZdrWn NAyX69 hFvmZh2RR9sRm/qR93YcntuK0m5EXtd0GwVd27aD/pUwv7IKAUgAAJ3gMCgeLs38vwbgZ3YGVGx4nm0LaEI2fqaRcfbFcG2z8hVYJ2FjN1Q3/bvKid9qQt6FFtuPCJ2BTHO TDUj4hrEGS1W/IlKXf9aRu/N5/aGvLJ3Y8x1SFzBAEQuD8EhsXbbYM8NG /U9ETEKz4mPOigJg60jxTrxPjFuT2Ey0 Otn9iOfMsFzIt2NJ50TBkfjuyafiP/7KJg6kSupOVt1uyecIq2BnyK2kWdcQECIHCHCIwQ7y4T7LJhKz72vBWhrp4iZutImVyn2ybHWWO 3xdFXP2fbZLHqgjnqwhD7mdppG3Q GIF1Q5BM2/cjWbd TNGJqPaftxkvfrqYDdnqBtD5ZO2XsO/acQYCIHA/CIwTb5d9W3G1omHPBRi57vZz2/3ytI4KltZTsesWinYLwvTpRDFT/ygjNm/4hc36JGCRwOo942O0BWJ8sOWP9hM3rXC2nzV/bB7Ddoyxqd24Y4xRWATcvYIt23fYI0/tx3ZLw49c4QIEQKBKBAriXeVYcBoEQAAEVoMA4r2aUDNQEACBe0IA8b6naDIWEACB1SCAeK8m1A wUBEDgnhBAvO8pmowFBEBgNQgg3qsJNQMFARC4JwQQ73uKJmMBARBYDQKI92pCzUBBAATuCQHE 56iyVhAAARWg0AQ7 fn54YXGMABOAAH6uAA4s2ixaINB BAhRxAvCsMGplRHZkRcSJOS3IA8Ua8ybrgAByokAOId4VBW3I1xzbZIhyogwOIN JN1gUH4ECFHEC8KwwamVEdmRFxIk5LcgDxRrzJuuAAHKiQA4h3hUFbcjXHNtkiHKiDA4g34k3WB QfgQIUcQLwrDBqZUR2ZEXEiTktyAPFGvMm64AAcqJADiHeFQVtyNcc22SIcqIMDiDfiTdYFB BAhRxAvCsMGplRHZkRcSJOS3IA8Ua8ybrgAByokAOId4VBW3I1xzbZIhyogwOI91Li/bRvtptdc1jKvtq9VD/aH0eyVDhwExxw4v3VV1 d7Mx2s2k24bVt9k9nXK1EkLb75klIYs9rIk3W70Oz03G5sRyaXcDQCn2pvMP4sNs0G7GV7aerRx YFFnDgPjkgur0RBT81wEFcVWDPmWXehSDFQv2037aLnRFvEeDdoSWWu787uDiUyjVGcn 72/kFLu5H63C8zwlLXImrcmDytkkk3s SKfrMMRVevfbHvWSMPttU4VJn2uNTs992dYJIufa7Zufv7Q5dvWBH6oRMtvA0kKsT bZrDul1WKDUr3is7Zhs5lwgmLfrnigsZmrfCbvBMirvRH67f8o/kbixFcYttniBARy4Gw6cR7wPu/YRPiM2YdvDCUuXaT7bNimhrMjpuRUmabvxIhXs9IteK1yFOqlv6bUT2s73kCUf1RsQSKkfMu/ElyDmpfLnRvp1wp3DWcsUlxRTru9m0rIID8yzlXB9uniHDNfvvSpgkUCZPetS XMrSpqNH2WV2k6P0k/uXMqsT 48yYZLday91H7pWp400naKQekY1S JdKm8e9JQrNwxLAYQGlGDA2viwHTxVtFwgmhEMhIoI7Sl8pzQ2bp6rsdUTLVcjzl7Wlaqk5aPuT 63eIc E/EO5cnELJXrWDmSacOBu bAfPEWgrhtDLMPrPvfmlWL0Kdik15bosk9taH19Cj1suciet3WRn4FLtSx9lL7zq 4XbRtoouY9b90nvRTemOyVB6NKbHl7kkZ2yZ3PWEjDpR4RvkqOHAe8VaR9sLhxM1vYcRvOPqP/wm5cuJjSCcCJtsC2fa2bXput05ywuoETt94LHzcztpUn6J2ZqHK9aFtzNFiIuNq32RtF4V2G8Q8 vfg99uNyk30XfeQNSwTO8MRwEFzuC5fJ4g0R7osIxJN4woG6OIB4k5ms4hETYapLmIjXcLwQb8Q b8YYDcKBCDiDeFQaNrGQ4KwEjMLp3DiDeiDdZFxyAAxVyAPGuMGj3nlEwPrJmODDMAcQb8Sbrgg NwoEIOIN4VBo2sZDgrASMwuncOIN6IN1kXHIADFXIA8a4waPeeUTA smY4MMwBxBvxJuuCA3CgQg4g3hUGjaxkOCsBIzC6dw4g3og3WRccgAMVcgDxrjBo955RMD6yZjg wzAHEG/Em64IDcKBCDiDeFQaNrGQ4KwEjMLp3DiDeiDdZFxyAAxVyAPGuMGguo8j9ks7Yscxpm/ZxTlup7VqvwYTF4ALcnSze6S 1tz/rdcOPauecUOe0NTXIgz4Ufm3e/rTc1L5tu0E/rsyJa/h3jT5tTDhfxeIxXbztbzcKWcPvMl55spaIe84JdU5bJX Hyk/xIa2bXg/11Xf/nLb6 pl67xr XaPPqfjQrlqhP494CwEsYeU8/BBw6Yd1N81uv2 26SIg187Wrtlt2x8K3h26LDJk FEf/kd3vQ97/ PF3Q/9du2lbLt/6gJWbOPHdDSOHlvhh5j9Dxz7scU/Pmx83aTYmB82Dv2aHxSOxux/PHnM5PNjfNK6o8ds ta2Guvgn/Ej8i8dW/ejz7cT936OZeP23MY/8ND9WHSCk8O3s73xP8wdtrsCdkk7xTiH45FN/RHrlKfepqu/b47nwkByVexbbdm4trayOI3tP ov5/uuOUS2cnPElG0LfjobXUxympIdx5h4a9wufDyfeDsSC4jtL6IruR0gu0PzfARCIvgqCireSvjDr gnkl3MniNKHIZEPrhN9 wQQ6mf6UqA9edTf59CmNI4hW51fh113Ht75FvsOj fmsDMTMJQXxpbgGi2WOpbSUfHR 71jNj6n7Vz7GJfOj7i8jrh7sRDsLd/8ohtiJuMO8ek5j/DthNlh0cdbbZfBN DoYtbZdP64OVDgSzHGfeJdiGFqK/I3sac4pW2k/AjXkb6ntpK5EGNk5pT109lYKN62nwueO/F 9epVl4mO7DzKmF0bHwgByQbJgdatniH7kza5utLWlufOnc0uk5NseiNEtnVTk9HWdartd6tPV0w UjvaR1PKudLKPPjDNmWyVSV6M8i5J5YYtvWHTM221fuPPW3dF3q29rsa1tr3O2Y0nMbizC TnSiBVhxsjakTK6Vn9aexlbbad3QT9LWljuubZv94Yx86fM76jsRbDc Mx lbs5WaiNtp3gMtc3dV3zTPhRb26bv3MYn2BqIt/Zx4aPo9kYUPMoyRjgRCbTUV0D0qDbkugRsrm4aeFtHz/WofegxLbfX9lzryzEt12s9al25HhRvJbUE2ywomtUd9SeP4JLpHpqdEiXt1/avdY7saL FY2qzdJ2Wa9/2mNbRaz1qXbmuJe7Wdz13/ptMV8v9 FrR7iZ1NH SupF42xgqVvY4uq307cU7ZzNnJ1dvUt GZ9JPjt9j k/rqC9p ZjrEtdyNq09PZdjbhy fW 8tY8LH8 0bdKKVbv1YM fm/BIU9o2UUHU/WIhmAIqYGTP4z7CxLF1c21NX8Nt4j66cZhsKA3W077Zhf10EebjyeXsmEkk17vdzuzDx/0GPzXTemonTmTHEc9sd2T8ihbbIk6lvs1kLfoRt 3wSveIj/ELY7F Zc/jPgI2tu6UuNv2eq5Hj2XwUbGVn7J/ZeEuN2q6zgv7Zzx7hOwDHxp7S9NwoTPxej935O6dv6m/gVcErKo3kc2sdjHee7cDFuV8Qo9FPSEVOe BvGoTbkfineWufCx nibR8v7IolA/ADDdsZOqiovN2bciB5W1sRsVHinfbhtyKSAKSEkdWz9IZl2M6xNiJ/Y3HM2vKkasfdvTGqdV3fOsYIk9h2jF yzZJiFfBObKh9vW/EJMUluo7GbPq29mS7p iHPj4bfxKbssjfVNzTmHuseuPmBNBk5hafZLzRXm/fPbUR1fE4RmX qS5bf8xcEPEb47vp2/JH /XHLE7ir22TXquNdFzSJq2bXkvbqN0IP62Nwnl2HOpnX7xDHZvkLH8 WbzDKnklx l/eXKAcQ/G2TfgeurPnSdWcObaMu 1EOORMbt0vEfEGPEeARIEH0nwFWEpWVr4hNIlxn1G8Zannov6fgl8Fu7j4vEeMR4n3hOv0NSwQN QYMDcAAOXI8DTrz/7h8Qb0h4PRKCPdjDgdM54MT757//Zv5HBUek ZMCdMbHxUn9LzWua9udguuUNtceJ/2fPLeZJ6cL6TUwc L9s0/ enKAo3eSl5wgaxaMJcc xfaUNktyQ23fql/qH8eT9eUaYlhbn068f/rb/zoZXMT7AqvzkqI0xfaUNgjXyXOrNhHB3wtoQWYeOfH yW/ 42SCiXjnvvTGfn43fF ETProD2Tkc6bms5nhM OZz546wei UCbYlME4u/q5YtM2V 7s5H2OyHdy2/YPBvRzz 5d/MiGGWfuc69Fv9o/blG77g8qIrt vFF701cO06h95jPc3pb7zLur6 25z7h2Xz Qi3s2FpFvbZxyn3KIOOMxisr0M8mRTzJhPI/U777 XFvlSmbsmckR8YL7J2sE C0r6q14//rfTg6M/LVRmIilz0Caz5NGH7UJ5UbEVYytwGmZTl77V5g6cXVS6QQulfvJ2 9zwZ9i28xfD/o/1NF nAjJF1EF/3xA9bpo2y9OAY RvpXGn/h15I/DsetD/Ja//GzH4f98v hr185N2DFjs3HThdx9x4suGIb4gS FL/Ma7E/8M3zV uoDx5PnP8Js Hkl/jjxfu/DP54cvGjbxE4GOQ9Zn8lwogloskZb150nk9faFpCcfZ8F5tqm/avNnJ0gjEZQSzZtXbWlRxu8tEyuRZxy5WKzVK5j1X6dHZM59o3rlDFY380XZLlvRJQ deHRo/pj/TvFN9ve9d0K6 wv8 rDsg/jZPyI0vVFiRiMi4ET7x//6g/nEW83iZPtizBZJUsVYR7xJUx2QuUmXk4MtU1av1Seq5crk/ZpuV7rUfso1c35q231qDbsdelc65b6C5gbElhbuXbepsu4DxojH7ODz8BLNtJy9S8tT6 1njsaEZd65mkrxr HR6l9vZbEwWKi5VH/BivKT9YDBPfy/HHi/e7D5ycHK5t5J5PCbRmYSaOP4t0X4iSPs7lJk7Ppvg 71LZQntiJBUGBP7XtidsmZnsgYNPnl9wLbUb6lm6PBEylfbewhv7DfY BfLnWdhu KOtpv3PbJ3v5QqyiryN9S9tL3 f4Mi 1q0cdU7iOxx6NQ oEjJUHHBHj2 dAK97vvzyPeLvH7u7RPnzRlJ1M6URxk6drE2VIfnJnt2H67uVshonciVS0AEU Jv70tU36cnvEUVm3DeQE029pBGz6bBs8j9 wLHwBUR8ukoGm/eu4wzEROpu19vkajbngW9re9dkKf/DLfytj75cEub46XIMYp/bttRm760uTitRWwOH2Jy8Cu 4YOfH 0S//5WTxhjjrJk7V8Rchd09vxLDqOK58oXXi/c4v/gnxXjkR7n0S20z 6M1RYs/8r5ADrXhv/5HgVRi8exdcxseTARwoc8CJ95//8jfEG/GGA3AADlTEASfe8h8rXHmFAxuwgQNw4NY44MT7T// F8S7ohX31kiEPwgbHLg8B5x4P3x8 ue8CdblgwXmYA4H4IBywIn3O7xhyZMHTx5wAA5UxQHEG8JWRVjNOjiSga6dA2ybIN6INxyAAxVy wIk3b1iSxaw9i2H8zIHaOODE 3/ 9/9YeStceWsjG/4ikHDgfBxw4r3789eIN INB AAHKiIA0683/nFPxO0ioJG9nK 7AUswbJWDjjx5lsFIXCtBMZvuLtWDnjx/ozMm8wbDsABOFARB1rxfv8VQasoaGvNNBg3WTYc6DjgxPvdhy8Qb8QbDsABOFARB5x4//iDLwlaRUEjiyD7AAi7VywIv3HxFvxBsOwAE4UBEHnHi/9 G/ErSKgrbWTINxk2XDgY4DTrx/8uuvEG/EGw7AAThQEQeceP/0t/9J0CoKGtlHl32ABVislQNOvH/28WvEG/GGA3AADlTEASfeP//9NwStoqCtNdNg3GTZcKDjgBPvzz7jLywhRUcKsAALOHD7HEC8ybh56oIDcKBCDjjxfvnyJcGrMH hkR7efHREjYrQUBxBvRJuFGw7AgQo5gHhXGLSlVnLskiXCgXo44MT71Su VRDS1kNaYkWs4MBz48T7xYsXPDaRgcMBOAAHKuKA6PYG8SaTIZOBA3CgLg448X710S9ZcStacZl kdU0y4kW8luDAq93fN5vPP3of8Ua84QAcgAMVccCJ9xcfI95LrIzYJOOCA3BgKQ448f7DJw suBWtuEuRAbsIDRyohwNOvL/83a8Qb8QbDsABOFARB5x482mTelZbMiNiBQfggHAA8a5opWXSMmnhABxQDiDeiDePynAADlTIAc S7wqDpysuRLAwOrJcDiDfiTdYFB BAhRxAvCsMGtnWerMtYk/slQOIN JN1gUH4ECFHEC8KwyarrwcycLgwHo5gHgj3mRdcAAOVMgBJ96Pn31E8CoMHlnXerMuYk/snXj/9SXizWRgMsABOFATB5x4f/3yYzJvMm84AAfgQEUcaMX7FeJd04qLr2SIcAAOOPH 26tPWHErWnGZuExcOAAHnHjzrYIQATGAA3CgLg6437BEvOsKGpOMeMEBOODE 5vP2TZhMjAZ4AAcqIkDbtvkv7/4HXve7HnDATgAByriAOJdUbBqygrwlSwWDizLAcQb8SbbggNwoEIOIN4VBo2MZtmMBnzBtwYOIN 6IN1kXHIADFXIA8a4waDVkBfhI9goHluUA4o14k3XBAThQIQcQ7wqDRkazbEYDvuBbAwcQb8Sbr AsOwIEKOYB4Vxi0GrICfCR7hQPLcgDxRrzJuuAAHKiQA4h3hUEjo1k2owFf8K2BA4g34k3WBQfg QIUcQLwrDFoNWQE kr3CgWU5gHgj3mRdcAAOVMgBxLvCoJHRLJvRgC/41sABxBvxJuuCA3CgQg4g3hUGrYasAB/JXuHAshzw4v0bVl5EHA7AAThQEQda8f74XYJWUdDIaJbNaMAXfGvggBPvhxcvEG/EGw7AAThQEQfY864oWDVkA/hI1goHLsMBxBvxJtuCA3CgQg5MEu Gf6MQ PrrrydNilHGqdRMxVcyw9evX/MaicGUTBp6jkNgDocni/cPP/zQ8Cpj8O23304WFwk72JaxFWzm4KviPW56rbeWCIssclPFGw4vy FZ4j0lqGtpM0dcVLzXgtWUcc7BV/oTUVKcEZljkVF854r3lNiupY1iPHW8iPdCe11zAqOiMjWoa2g3B1/Bx4r3GvA6dYyKL K93JuPivGpsdH6iDfiPemxWAl0reNc4ufEe7PZOCzWfpSYKr6IN JdpUDMESYl/xQbZN7DE2YOvhKTVLxVsKfE657aKA6KL I9zMWp8VeMp7Yn8ybznrewPu2b7XbfPC2EY4nYc4mfinepn8XLr4Tf0LgU37sU7xvBXDEeikXp/lXFW5y3r5KTfeXS3t5Pr 29S56LH1M/BnTRzFuIvNk0knF1r22zfxqZcVxpIszBV3iQirdmnLM4ksFydxjA8Ur4lcapOCi Ny/eOfxyZTa5GLpv6y54rhiXYjFUfjXxFsfFufTfkMPpfbEj/2x5em3vXep8TmDEf/kExEV8nUvkue0nTo45 AquqXifBesUC7nebJpeAU/bTMTjLP6bvhVfxHtg8TWYnRoDxfjUdlrfifeLE7/bZK64iNPiQElk5b6 1FG91mOuXMrkvh61rpZpubZNr3P1bd1TzsVWNZl3btvDi8p 12XkQYS8KIVMPdd BqnH4DwHX7GfirdmnGP6LtbJCbEti3DzTzfu/q7ZbRVnW262o4p2Ns3mjPgrDopv9eJdxHzfPB1hP7DQnpnTinGRTwP9iW5vriHefcItg9F/MkC5lqP911cu9YbqK2BaT 1pH3qt9U49SvtqxDvaMvFi4EkfBPuw8yJxaHY2m7SiMkC2UzHsqz8HX7GbindfX6PvZbEQvHbN4 VmPPpPTug7nbpvqab9tcdb7imm4vgz im8V4p3yV67dgtaDudxPsH8WjrtYLZdtWy4pxrbslHMn3m/evDnpEV0Ebs5jvTgt/3KOpvf0Wo/aRq/1eI5ysWVfJR 1r76j2KlGvHOZWxCLjNjY mk9FZuFj3Pwlbil4q0ZZ19MB 9lsfAC4oRCs2s97ppD2sbVK5Sr4CyIv Kg FYh3hYP4Z1iOoS51gtclVh1C lgvEO7aWKvGE/tR3R7g3gfZ pudSksMGPAnhMY6XvO4jjGv1DniMCJWCtBtZ4e03K9vtBxDr4y9lS8Ax5z/E xEVtapsfUflou15L95cpFpMITUCFOqf2J14pv9eKdCntvTBDvbEadTg4hR1om11JuM1691qO20W s9LlGuNqccxa 7zLzd43 XnYTH/IkiMQVbaTMHX2mfirdmnFP9ce1SwXVY6T6qCIOem0wtaePw3B1a0TeP8B3OicAk7Wf5//zsPnEkNhTfqsU7wj DeYpdujAuzGnFeGrMrpJ5q7PivH3lyqVM/km9nKjLfbWh52Prazu1q9dy1H7lOOUlNqoR76M9w22zPySf37ZEd3uD7aP/drfjc97KEcEowrJb5ByH0vuSFebKvD0n2N5ehLPBXxadc75hqVxX/tYt3v7Jx8ZEMdejvWcWS8VhyaNiPLWPq4q3OJ3 04HYclum59pWr7W LZcyvW/L9Vzb2Hq5Mmtj7PmcwIgPF9s2UeGp7DgHX4nhIpn3NTAUIZdM/Ux96xOI4nvz4j1n3DYhmWNnYlvFeGrsriLe4nTpNXUgt9ZuTmAuLd4ue4sykDarvjVMrT9z8BU7 qXhb23POS1iqKM6xrW0P5uObS306QvGtQbwnY454T9tWsBlueq4krfmo5J8yhkuL9xQfr91mDr7 ieyre5xTXa2Mzp3/FQfGtQbznjPeabRXjqT5cJfOe6mxN7eYEBvEeTgjm4Cs8SsVbylS41n4ULBRfxHuYi1N1STGe2h 7xnrhfNQT4nMAg3sMTZg6 EruceA/FdE33FV/Ee5iLU3mhGE9tj3gj3md7s2sqCae0m0t8FW xwyuPgXxaCvG Q/GG8HnCW1zmfFTQ2uE8j/VUfGWxEFGS9rz6MZgj3vA2z1uLyxwOT8q8IXw/4S0 U7JK257zfqyn4KviLcLEaxiDKRjD237eWnym4CttJon31M5ot9wjGNiCLRxYFwcQ74X2vJlI65p IxJt4X5oDiDfiXeUblpeeKPSHON8aBxBvxBvxhgNwoEIOOPE 9ccYbm0Fwh yIjgAB9bGgUk/xrA2kBgvwgAH4MCtcYBtkwofl26NRPiDsMGBy3MA8Ua82e EA3CgQg4g3hUGjSzn8lkOmIP5rXEA8Ua8ybrgAByokANBvOVk6PXlB 81n77O1/vygxfNe5djbk/MV7nzavR9hM 5R3UNMyrvOYW1zuAbdbHcO5uG3jde7zW8Xu3OMs2Vvr P8fFAZTR2xSMFMAAAAASUVORK5CYII=
But some of the condition this error message is not displaying.
Mu code is here
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.
I wrote code for sending mail with pdf attachment. When i am running my code i am getting following error message
http://www.vbaexpress.com/forum/image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAW8AAADLCAYAAAChxhJYAAAd2ElEQVR4Ae2dX7Ij t3XGuY1ZgizLLrsqtHWtkl2WZFeUVBLNSFbZiRImHl XrPyZXfB1lqB3vmsZdwN61AbuDjp10DjoAxDobnazSYL9mypOd6OBg4PvfPhwGuQlN2/evGl4gQEcgANwoC4ObCRg/AMBEAABEKgHAdFtxLueeOEpCIAACDgEEG IAAIgAAIVIoB4Vxg0XAYBEAABxBsOgAAIgECFCCDeFQYNl0EABEAA8YYDIAACIFAhAgXx/q553GyazeN32SF9//ah2WwemrffN03z/dvmQc ztS9Q N1jsxF/H9424lLp33ePm bBOW1qSFsZ5yLjEBw9TqbLpvH4is/ VYA6anV0sYjPR71QAAIgcIMI9Ij3Q/Pw0Cc8uXvXGGErhJ34lQSzaRoVauOmCHrX1tw4y2nJl6TcifBjk18qz IIRkAABO4MgV7xfnx8KGSqj4WM8hroJELostrCwnIkktJ2SdFMfVN80vL0WutxBAEQAIE8Ar3i/fb7VNy b966bNyKjT2XTqROuh3Q1pHFYKNi6YQ0rVdqr9szaX2x25U9vH0bXR9v 7S hUw7ysTtOMpj6HZdbH1J6js/un7jOl0IkvLIj5KtMT7l6nS9cgYCIHA/CAyIdyskQexEcN2 shUfe96Kx9G st/j7cqljdmucELus VEyFqoe ofZdrWn NAyX69 hFvmZh2RR9sRm/qR93YcntuK0m5EXtd0GwVd27aD/pUwv7IKAUgAAJ3gMCgeLs38vwbgZ3YGVGx4nm0LaEI2fqaRcfbFcG2z8hVYJ2FjN1Q3/bvKid9qQt6FFtuPCJ2BTHO TDUj4hrEGS1W/IlKXf9aRu/N5/aGvLJ3Y8x1SFzBAEQuD8EhsXbbYM8NG /U9ETEKz4mPOigJg60jxTrxPjFuT2Ey0 Otn9iOfMsFzIt2NJ50TBkfjuyafiP/7KJg6kSupOVt1uyecIq2BnyK2kWdcQECIHCHCIwQ7y4T7LJhKz72vBWhrp4iZutImVyn2ybHWWO 3xdFXP2fbZLHqgjnqwhD7mdppG3Q GIF1Q5BM2/cjWbd TNGJqPaftxkvfrqYDdnqBtD5ZO2XsO/acQYCIHA/CIwTb5d9W3G1omHPBRi57vZz2/3ytI4KltZTsesWinYLwvTpRDFT/ygjNm/4hc36JGCRwOo942O0BWJ8sOWP9hM3rXC2nzV/bB7Ddoyxqd24Y4xRWATcvYIt23fYI0/tx3ZLw49c4QIEQKBKBAriXeVYcBoEQAAEVoMA4r2aUDNQEACBe0IA8b6naDIWEACB1SCAeK8m1A wUBEDgnhBAvO8pmowFBEBgNQgg3qsJNQMFARC4JwQQ73uKJmMBARBYDQKI92pCzUBBAATuCQHE 56iyVhAAARWg0AQ7 fn54YXGMABOAAH6uAA4s2ixaINB BAhRxAvCsMGplRHZkRcSJOS3IA8Ua8ybrgAByokAOId4VBW3I1xzbZIhyogwOIN JN1gUH4ECFHEC8KwwamVEdmRFxIk5LcgDxRrzJuuAAHKiQA4h3hUFbcjXHNtkiHKiDA4g34k3WB QfgQIUcQLwrDBqZUR2ZEXEiTktyAPFGvMm64AAcqJADiHeFQVtyNcc22SIcqIMDiDfiTdYFB BAhRxAvCsMGplRHZkRcSJOS3IA8Ua8ybrgAByokAOId4VBW3I1xzbZIhyogwOI91Li/bRvtptdc1jKvtq9VD/aH0eyVDhwExxw4v3VV1 d7Mx2s2k24bVt9k9nXK1EkLb75klIYs9rIk3W70Oz03G5sRyaXcDQCn2pvMP4sNs0G7GV7aerRx YFFnDgPjkgur0RBT81wEFcVWDPmWXehSDFQv2037aLnRFvEeDdoSWWu787uDiUyjVGcn 72/kFLu5H63C8zwlLXImrcmDytkkk3s SKfrMMRVevfbHvWSMPttU4VJn2uNTs992dYJIufa7Zufv7Q5dvWBH6oRMtvA0kKsT bZrDul1WKDUr3is7Zhs5lwgmLfrnigsZmrfCbvBMirvRH67f8o/kbixFcYttniBARy4Gw6cR7wPu/YRPiM2YdvDCUuXaT7bNimhrMjpuRUmabvxIhXs9IteK1yFOqlv6bUT2s73kCUf1RsQSKkfMu/ElyDmpfLnRvp1wp3DWcsUlxRTru9m0rIID8yzlXB9uniHDNfvvSpgkUCZPetS XMrSpqNH2WV2k6P0k/uXMqsT 48yYZLday91H7pWp400naKQekY1S JdKm8e9JQrNwxLAYQGlGDA2viwHTxVtFwgmhEMhIoI7Sl8pzQ2bp6rsdUTLVcjzl7Wlaqk5aPuT 63eIc E/EO5cnELJXrWDmSacOBu bAfPEWgrhtDLMPrPvfmlWL0Kdik15bosk9taH19Cj1suciet3WRn4FLtSx9lL7zq 4XbRtoouY9b90nvRTemOyVB6NKbHl7kkZ2yZ3PWEjDpR4RvkqOHAe8VaR9sLhxM1vYcRvOPqP/wm5cuJjSCcCJtsC2fa2bXput05ywuoETt94LHzcztpUn6J2ZqHK9aFtzNFiIuNq32RtF4V2G8Q8 vfg99uNyk30XfeQNSwTO8MRwEFzuC5fJ4g0R7osIxJN4woG6OIB4k5ms4hETYapLmIjXcLwQb8Q b8YYDcKBCDiDeFQaNrGQ4KwEjMLp3DiDeiDdZFxyAAxVyAPGuMGj3nlEwPrJmODDMAcQb8Sbrgg NwoEIOIN4VBo2sZDgrASMwuncOIN6IN1kXHIADFXIA8a4waPeeUTA smY4MMwBxBvxJuuCA3CgQg4g3hUGjaxkOCsBIzC6dw4g3og3WRccgAMVcgDxrjBo955RMD6yZjg wzAHEG/Em64IDcKBCDiDeFQaNrGQ4KwEjMLp3DiDeiDdZFxyAAxVyAPGuMGguo8j9ks7Yscxpm/ZxTlup7VqvwYTF4ALcnSze6S 1tz/rdcOPauecUOe0NTXIgz4Ufm3e/rTc1L5tu0E/rsyJa/h3jT5tTDhfxeIxXbztbzcKWcPvMl55spaIe84JdU5bJX Hyk/xIa2bXg/11Xf/nLb6 pl67xr XaPPqfjQrlqhP494CwEsYeU8/BBw6Yd1N81uv2 26SIg187Wrtlt2x8K3h26LDJk FEf/kd3vQ97/ PF3Q/9du2lbLt/6gJWbOPHdDSOHlvhh5j9Dxz7scU/Pmx83aTYmB82Dv2aHxSOxux/PHnM5PNjfNK6o8ds ta2Guvgn/Ej8i8dW/ejz7cT936OZeP23MY/8ND9WHSCk8O3s73xP8wdtrsCdkk7xTiH45FN/RHrlKfepqu/b47nwkByVexbbdm4trayOI3tP ov5/uuOUS2cnPElG0LfjobXUxympIdx5h4a9wufDyfeDsSC4jtL6IruR0gu0PzfARCIvgqCireSvjDr gnkl3MniNKHIZEPrhN9 wQQ6mf6UqA9edTf59CmNI4hW51fh113Ht75FvsOj fmsDMTMJQXxpbgGi2WOpbSUfHR 71jNj6n7Vz7GJfOj7i8jrh7sRDsLd/8ohtiJuMO8ek5j/DthNlh0cdbbZfBN DoYtbZdP64OVDgSzHGfeJdiGFqK/I3sac4pW2k/AjXkb6ntpK5EGNk5pT109lYKN62nwueO/F 9epVl4mO7DzKmF0bHwgByQbJgdatniH7kza5utLWlufOnc0uk5NseiNEtnVTk9HWdartd6tPV0w UjvaR1PKudLKPPjDNmWyVSV6M8i5J5YYtvWHTM221fuPPW3dF3q29rsa1tr3O2Y0nMbizC TnSiBVhxsjakTK6Vn9aexlbbad3QT9LWljuubZv94Yx86fM76jsRbDc Mx lbs5WaiNtp3gMtc3dV3zTPhRb26bv3MYn2BqIt/Zx4aPo9kYUPMoyRjgRCbTUV0D0qDbkugRsrm4aeFtHz/WofegxLbfX9lzryzEt12s9al25HhRvJbUE2ywomtUd9SeP4JLpHpqdEiXt1/avdY7saL FY2qzdJ2Wa9/2mNbRaz1qXbmuJe7Wdz13/ptMV8v9 FrR7iZ1NH SupF42xgqVvY4uq307cU7ZzNnJ1dvUt GZ9JPjt9j k/rqC9p ZjrEtdyNq09PZdjbhy fW 8tY8LH8 0bdKKVbv1YM fm/BIU9o2UUHU/WIhmAIqYGTP4z7CxLF1c21NX8Nt4j66cZhsKA3W077Zhf10EebjyeXsmEkk17vdzuzDx/0GPzXTemonTmTHEc9sd2T8ihbbIk6lvs1kLfoRt 3wSveIj/ELY7F Zc/jPgI2tu6UuNv2eq5Hj2XwUbGVn7J/ZeEuN2q6zgv7Zzx7hOwDHxp7S9NwoTPxej935O6dv6m/gVcErKo3kc2sdjHee7cDFuV8Qo9FPSEVOe BvGoTbkfineWufCx nibR8v7IolA/ADDdsZOqiovN2bciB5W1sRsVHinfbhtyKSAKSEkdWz9IZl2M6xNiJ/Y3HM2vKkasfdvTGqdV3fOsYIk9h2jF yzZJiFfBObKh9vW/EJMUluo7GbPq29mS7p iHPj4bfxKbssjfVNzTmHuseuPmBNBk5hafZLzRXm/fPbUR1fE4RmX qS5bf8xcEPEb47vp2/JH /XHLE7ir22TXquNdFzSJq2bXkvbqN0IP62Nwnl2HOpnX7xDHZvkLH8 WbzDKnklx l/eXKAcQ/G2TfgeurPnSdWcObaMu 1EOORMbt0vEfEGPEeARIEH0nwFWEpWVr4hNIlxn1G8Zannov6fgl8Fu7j4vEeMR4n3hOv0NSwQN QYMDcAAOXI8DTrz/7h8Qb0h4PRKCPdjDgdM54MT757//Zv5HBUek ZMCdMbHxUn9LzWua9udguuUNtceJ/2fPLeZJ6cL6TUwc L9s0/ enKAo3eSl5wgaxaMJcc xfaUNktyQ23fql/qH8eT9eUaYlhbn068f/rb/zoZXMT7AqvzkqI0xfaUNgjXyXOrNhHB3wtoQWYeOfH yW/ 42SCiXjnvvTGfn43fF ETProD2Tkc6bms5nhM OZz546wei UCbYlME4u/q5YtM2V 7s5H2OyHdy2/YPBvRzz 5d/MiGGWfuc69Fv9o/blG77g8qIrt vFF701cO06h95jPc3pb7zLur6 25z7h2Xz Qi3s2FpFvbZxyn3KIOOMxisr0M8mRTzJhPI/U777 XFvlSmbsmckR8YL7J2sE C0r6q14//rfTg6M/LVRmIilz0Caz5NGH7UJ5UbEVYytwGmZTl77V5g6cXVS6QQulfvJ2 9zwZ9i28xfD/o/1NF nAjJF1EF/3xA9bpo2y9OAY RvpXGn/h15I/DsetD/Ja//GzH4f98v hr185N2DFjs3HThdx9x4suGIb4gS FL/Ma7E/8M3zV uoDx5PnP8Js Hkl/jjxfu/DP54cvGjbxE4GOQ9Zn8lwogloskZb150nk9faFpCcfZ8F5tqm/avNnJ0gjEZQSzZtXbWlRxu8tEyuRZxy5WKzVK5j1X6dHZM59o3rlDFY380XZLlvRJQ deHRo/pj/TvFN9ve9d0K6 wv8 rDsg/jZPyI0vVFiRiMi4ET7x//6g/nEW83iZPtizBZJUsVYR7xJUx2QuUmXk4MtU1av1Seq5crk/ZpuV7rUfso1c35q231qDbsdelc65b6C5gbElhbuXbepsu4DxojH7ODz8BLNtJy9S8tT6 1njsaEZd65mkrxr HR6l9vZbEwWKi5VH/BivKT9YDBPfy/HHi/e7D5ycHK5t5J5PCbRmYSaOP4t0X4iSPs7lJk7Ppvg 71LZQntiJBUGBP7XtidsmZnsgYNPnl9wLbUb6lm6PBEylfbewhv7DfY BfLnWdhu KOtpv3PbJ3v5QqyiryN9S9tL3 f4Mi 1q0cdU7iOxx6NQ oEjJUHHBHj2 dAK97vvzyPeLvH7u7RPnzRlJ1M6URxk6drE2VIfnJnt2H67uVshonciVS0AEU Jv70tU36cnvEUVm3DeQE029pBGz6bBs8j9 wLHwBUR8ukoGm/eu4wzEROpu19vkajbngW9re9dkKf/DLfytj75cEub46XIMYp/bttRm760uTitRWwOH2Jy8Cu 4YOfH 0S//5WTxhjjrJk7V8Rchd09vxLDqOK58oXXi/c4v/gnxXjkR7n0S20z 6M1RYs/8r5ADrXhv/5HgVRi8exdcxseTARwoc8CJ95//8jfEG/GGA3AADlTEASfe8h8rXHmFAxuwgQNw4NY44MT7T// F8S7ohX31kiEPwgbHLg8B5x4P3x8 ue8CdblgwXmYA4H4IBywIn3O7xhyZMHTx5wAA5UxQHEG8JWRVjNOjiSga6dA2ybIN6INxyAAxVy wIk3b1iSxaw9i2H8zIHaOODE 3/ 9/9YeStceWsjG/4ikHDgfBxw4r3789eIN INB AAHKiIA0683/nFPxO0ioJG9nK 7AUswbJWDjjx5lsFIXCtBMZvuLtWDnjx/ozMm8wbDsABOFARB1rxfv8VQasoaGvNNBg3WTYc6DjgxPvdhy8Qb8QbDsABOFARB5x4//iDLwlaRUEjiyD7AAi7VywIv3HxFvxBsOwAE4UBEHnHi/9 G/ErSKgrbWTINxk2XDgY4DTrx/8uuvEG/EGw7AAThQEQeceP/0t/9J0CoKGtlHl32ABVislQNOvH/28WvEG/GGA3AADlTEASfeP//9NwStoqCtNdNg3GTZcKDjgBPvzz7jLywhRUcKsAALOHD7HEC8ybh56oIDcKBCDjjxfvnyJcGrMH hkR7efHREjYrQUBxBvRJuFGw7AgQo5gHhXGLSlVnLskiXCgXo44MT71Su VRDS1kNaYkWs4MBz48T7xYsXPDaRgcMBOAAHKuKA6PYG8SaTIZOBA3CgLg448X710S9ZcStacZl kdU0y4kW8luDAq93fN5vPP3of8Ua84QAcgAMVccCJ9xcfI95LrIzYJOOCA3BgKQ448f7DJw suBWtuEuRAbsIDRyohwNOvL/83a8Qb8QbDsABOFARB5x482mTelZbMiNiBQfggHAA8a5opWXSMmnhABxQDiDeiDePynAADlTIAc S7wqDpysuRLAwOrJcDiDfiTdYFB BAhRxAvCsMGtnWerMtYk/slQOIN JN1gUH4ECFHEC8KwyarrwcycLgwHo5gHgj3mRdcAAOVMgBJ96Pn31E8CoMHlnXerMuYk/snXj/9SXizWRgMsABOFATB5x4f/3yYzJvMm84AAfgQEUcaMX7FeJd04qLr2SIcAAOOPH 26tPWHErWnGZuExcOAAHnHjzrYIQATGAA3CgLg6437BEvOsKGpOMeMEBOODE 5vP2TZhMjAZ4AAcqIkDbtvkv7/4HXve7HnDATgAByriAOJdUbBqygrwlSwWDizLAcQb8SbbggNwoEIOIN4VBo2MZtmMBnzBtwYOIN 6IN1kXHIADFXIA8a4waDVkBfhI9goHluUA4o14k3XBAThQIQcQ7wqDRkazbEYDvuBbAwcQb8Sbr AsOwIEKOYB4Vxi0GrICfCR7hQPLcgDxRrzJuuAAHKiQA4h3hUEjo1k2owFf8K2BA4g34k3WBQfg QIUcQLwrDFoNWQE kr3CgWU5gHgj3mRdcAAOVMgBxLvCoJHRLJvRgC/41sABxBvxJuuCA3CgQg4g3hUGrYasAB/JXuHAshzw4v0bVl5EHA7AAThQEQda8f74XYJWUdDIaJbNaMAXfGvggBPvhxcvEG/EGw7AAThQEQfY864oWDVkA/hI1goHLsMBxBvxJtuCA3CgQg5MEu Gf6MQ PrrrydNilHGqdRMxVcyw9evX/MaicGUTBp6jkNgDocni/cPP/zQ8Cpj8O23304WFwk72JaxFWzm4KviPW56rbeWCIssclPFGw4vy FZ4j0lqGtpM0dcVLzXgtWUcc7BV/oTUVKcEZljkVF854r3lNiupY1iPHW8iPdCe11zAqOiMjWoa2g3B1/Bx4r3GvA6dYyKL K93JuPivGpsdH6iDfiPemxWAl0reNc4ufEe7PZOCzWfpSYKr6IN JdpUDMESYl/xQbZN7DE2YOvhKTVLxVsKfE657aKA6KL I9zMWp8VeMp7Yn8ybznrewPu2b7XbfPC2EY4nYc4mfinepn8XLr4Tf0LgU37sU7xvBXDEeikXp/lXFW5y3r5KTfeXS3t5Pr 29S56LH1M/BnTRzFuIvNk0knF1r22zfxqZcVxpIszBV3iQirdmnLM4ksFydxjA8Ur4lcapOCi Ny/eOfxyZTa5GLpv6y54rhiXYjFUfjXxFsfFufTfkMPpfbEj/2x5em3vXep8TmDEf/kExEV8nUvkue0nTo45 AquqXifBesUC7nebJpeAU/bTMTjLP6bvhVfxHtg8TWYnRoDxfjUdlrfifeLE7/bZK64iNPiQElk5b6 1FG91mOuXMrkvh61rpZpubZNr3P1bd1TzsVWNZl3btvDi8p 12XkQYS8KIVMPdd BqnH4DwHX7GfirdmnGP6LtbJCbEti3DzTzfu/q7ZbRVnW262o4p2Ns3mjPgrDopv9eJdxHzfPB1hP7DQnpnTinGRTwP9iW5vriHefcItg9F/MkC5lqP911cu9YbqK2BaT 1pH3qt9U49SvtqxDvaMvFi4EkfBPuw8yJxaHY2m7SiMkC2UzHsqz8HX7GbindfX6PvZbEQvHbN4 VmPPpPTug7nbpvqab9tcdb7imm4vgz im8V4p3yV67dgtaDudxPsH8WjrtYLZdtWy4pxrbslHMn3m/evDnpEV0Ebs5jvTgt/3KOpvf0Wo/aRq/1eI5ysWVfJR 1r76j2KlGvHOZWxCLjNjY mk9FZuFj3Pwlbil4q0ZZ19MB 9lsfAC4oRCs2s97ppD2sbVK5Sr4CyIv Kg FYh3hYP4Z1iOoS51gtclVh1C lgvEO7aWKvGE/tR3R7g3gfZ pudSksMGPAnhMY6XvO4jjGv1DniMCJWCtBtZ4e03K9vtBxDr4y9lS8Ax5z/E xEVtapsfUflou15L95cpFpMITUCFOqf2J14pv9eKdCntvTBDvbEadTg4hR1om11JuM1691qO20W s9LlGuNqccxa 7zLzd43 XnYTH/IkiMQVbaTMHX2mfirdmnFP9ce1SwXVY6T6qCIOem0wtaePw3B1a0TeP8B3OicAk7Wf5//zsPnEkNhTfqsU7wj DeYpdujAuzGnFeGrMrpJ5q7PivH3lyqVM/km9nKjLfbWh52Prazu1q9dy1H7lOOUlNqoR76M9w22zPySf37ZEd3uD7aP/drfjc97KEcEowrJb5ByH0vuSFebKvD0n2N5ehLPBXxadc75hqVxX/tYt3v7Jx8ZEMdejvWcWS8VhyaNiPLWPq4q3OJ3 04HYclum59pWr7W LZcyvW/L9Vzb2Hq5Mmtj7PmcwIgPF9s2UeGp7DgHX4nhIpn3NTAUIZdM/Ux96xOI4nvz4j1n3DYhmWNnYlvFeGrsriLe4nTpNXUgt9ZuTmAuLd4ue4sykDarvjVMrT9z8BU7 qXhb23POS1iqKM6xrW0P5uObS306QvGtQbwnY454T9tWsBlueq4krfmo5J8yhkuL9xQfr91mDr7 ieyre5xTXa2Mzp3/FQfGtQbznjPeabRXjqT5cJfOe6mxN7eYEBvEeTgjm4Cs8SsVbylS41n4ULBRfxHuYi1N1STGe2h 7xnrhfNQT4nMAg3sMTZg6 EruceA/FdE33FV/Ee5iLU3mhGE9tj3gj3md7s2sqCae0m0t8FW xwyuPgXxaCvG Q/GG8HnCW1zmfFTQ2uE8j/VUfGWxEFGS9rz6MZgj3vA2z1uLyxwOT8q8IXw/4S0 U7JK257zfqyn4KviLcLEaxiDKRjD237eWnym4CttJon31M5ot9wjGNiCLRxYFwcQ74X2vJlI65p IxJt4X5oDiDfiXeUblpeeKPSHON8aBxBvxBvxhgNwoEIOOPE 9ccYbm0Fwh yIjgAB9bGgUk/xrA2kBgvwgAH4MCtcYBtkwofl26NRPiDsMGBy3MA8Ua82e EA3CgQg4g3hUGjSzn8lkOmIP5rXEA8Ua8ybrgAByokANBvOVk6PXlB 81n77O1/vygxfNe5djbk/MV7nzavR9hM 5R3UNMyrvOYW1zuAbdbHcO5uG3jde7zW8Xu3OMs2Vvr P8fFAZTR2xSMFMAAAAASUVORK5CYII=
But some of the condition this error message is not displaying.
Mu code is here
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.