Hi,
I've created one macro to send e-mails from excel automatically in picture format. (I have one Pre-defined format of e-mail in excel sheet which is getting copied & paste in lotus notes in image format, every-time when macro runs).
Problem: I'am not able to send e-mail. I know fault is somewhere in below code. With below mentioned entire code of program, I'am able to create new document & paste my e-mail template into body but not able to send e-mail & getting error:
Run Time Error 438
Object does't not support this property or method
When I remove below code, then I'am not getting any error & e-mails are saved in new document but not sent automatically.Code:Set Ballu = MailDoc.CreateRichTextItem("Body") With Ballu Set Session = CreateObject("Notes.NotesUIWorkspace") Set MailDoc = Session.editdocument(True, MailDoc, False) Call MailDoc.GOTOFIELD("Body") Worksheets("Range").Select ActiveSheet.Range("A1:F44").Copy Call MailDoc.Paste End With MailDoc.SaveMessageOnSend = True MailDoc.PostedDate = Now() On Error GoTo errorhandler1 MailDoc.SEND 0, Recipient
Please someone help me to clarify how to resolve this error. I guess error is occuring because I'am sending e-mail in image format instead of text.Code:MailDoc.SaveMessageOnSend = True MailDoc.PostedDate = Now() On Error GoTo errorhandler1 MailDoc.SEND 0, Recipient
Any suggestion would be highly appreciable..!!!
My Entire Code:
Code:Sub NotsCoreCode() Dim thisWB As String Dim newWB As String Dim Pol_No As String Dim Bank_Account_Number As String Dim Transaction_Amount As String Dim Bank_Name As String Dim Email As String thisWB = ActiveWorkbook.Name On Error Resume Next Sheets("tempsheet").Delete On Error GoTo 0 Sheets.Add ActiveSheet.Name = "tempsheet" Sheets("Data").Select If ActiveSheet.AutoFilterMode Then Cells.Select On Error Resume Next ActiveSheet.ShowAllData On Error GoTo 0 End If Columns("A:A").Select Selection.Copy Sheets("tempsheet").Select Range("A1").Select ActiveSheet.Paste Application.CutCopyMode = False If (Cells(1, 1) = "") Then lastrow = Cells(1, 1).End(xlDown).Row If lastrow <> Rows.Count Then Range("A1:A" & lastrow - 1).Select Selection.Delete Shift:=xlUp End If End If Columns("A:A").Select Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True Columns("A:A").Delete Cells.Select Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal lMaxSupp = Cells(Rows.Count, 1).End(xlUp).Row For suppNo = 2 To lMaxSupp Windows(thisWB).Activate SupName = Sheets("tempsheet").Range("A" & suppNo) If SupName <> "" Then Sheets("Data").Select Cells.Select ActiveSheet.Range("$A$1:$E$65000").AutoFilter Field:=1, Criteria1:="=" & SupName Columns("A:E").Select Range(Selection, Selection.End(xlUp)).Select Selection.Copy Sheets("Sheet5").Select Range("A1").Select ActiveSheet.Paste Cells.Select Cells.EntireColumn.AutoFit 'Storing e-mail id into Email variable where email need to be sent Email = Range("E2").Value Range("A2:D2").Select Application.CutCopyMode = False Selection.Copy Sheets("Range").Select Range("B23").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Range("A1").Select End If With Application .ScreenUpdating = False .DisplayAlerts = False End With ' Declare Variables for and macro setup Dim UserName As String Dim MailDbName As String Dim Maildb As Object Dim MailDoc As Object Dim AttachME As Object Dim Session As Object Dim EmbedObj1 As Object Dim t1 As Range Dim objNotesSession As Object Dim objNotesMailFile As Object Dim objNotesDocument As Object Dim objNotesField As Object ' Open and locate current LOTUS NOTES User Set Session = CreateObject("Notes.NotesSession") UserName = Session.UserName MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf" Set Maildb = Session.GETDATABASE("", MailDbName) If Maildb.IsOpen = True Then Else Maildb.OPENMAIL End If ' Create New Mail and Address Title Handlers Set MailDoc = Maildb.CreateDocument MailDoc.Form = "Memo" ' Select range of e-mail addresses Recipient = Email MailDoc.SendTo = Recipient MailDoc.Subject = "ECS Transaction Pre-Hit Intimation" Set Ballu = MailDoc.CreateRichTextItem("Body") With Ballu Set Session = CreateObject("Notes.NotesUIWorkspace") Set MailDoc = Session.editdocument(True, MailDoc, False) Call MailDoc.GOTOFIELD("Body") Worksheets("Range").Select ActiveSheet.Range("A1:F44").Copy Call MailDoc.Paste End With MailDoc.SaveMessageOnSend = True MailDoc.PostedDate = Now() On Error GoTo errorhandler1 MailDoc.SEND 0, Recipient Set Maildb = Nothing Set MailDoc = Nothing Set AttachME = Nothing Set Session = Nothing Set EmbedObj1 = Nothing errorhandler1: Set Maildb = Nothing Set MailDoc = Nothing Set AttachME = Nothing Set Session = Nothing Set EmbedObj1 = Nothing With Application .ScreenUpdating = True .DisplayAlerts = True End With Next Sheets("tempsheet").Delete Sheets("Total Data").Select If ActiveSheet.AutoFilterMode Then Cells.Select ActiveSheet.ShowAllData End If End Sub




Reply With Quote