Auto Mail
I have macro which can send mail with attachement to the mail adderss
metnioned in column A. This work fine if that attachement sheets also their in that particular workbook. But same macro fails to work when i select some other file... Macro as follow: Sub Mail_Every_Worksheet() 'Working in 2000-2007 Dim sh As Worksheet 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 MailAdress As String TempFilePath = Environ$("temp") & "\" If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007 FileExtStr = ".xlsm": FileFormatNum = 52 End If With Application .ScreenUpdating = False .EnableEvents = False End With Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon For Each sh In ActiveWorkbook.Worksheets MailAdress = "" On Error Resume Next MailAdress = Application.WorksheetFunction.VLookup(Int(sh.Name) , Sheets("LookupTable").Range("A1:B500"), 2, False) On Error GoTo 0 strbody = "Dear All" & vbNewLine & vbNewLine & _ "Please find attached file of Credit/Debit given to your account on dt" & " " & Format(Now, "dd-mmm-yy") & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "Thanks & Regards" & vbNewLine & _ "" & vbNewLine & _ "" & vbNewLine & _ "" If MailAdress Like "?*@?*.?*" Then sh.Copy Set wb = ActiveWorkbook TempFileName = "Daily Credit MIS Dt." & " " & Format(Now, "dd-mmm-yy") & " " & sh.Name Set OutMail = OutApp.CreateItem(0) With wb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next With OutMail .to = MailAdress .CC = "" .BCC = "" .Subject = "TRANSACTIONS" & " " & sh.Name .Body = strbody .Attachments.Add wb.FullName 'You can add other files also like this '.Attachments.Add ("C:\test.txt") .display 'or use .Display End With On Error GoTo 0 .Close SaveChanges:=False End With Set OutMail = Nothing Kill TempFilePath & TempFileName & FileExtStr End If Next sh Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
All times are GMT +1. The time now is 11:15 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com