Pavan.Sada.PS
Member
Hello Friends,
I am trying to copy a range of cells and paste it in lotus notes email. I am using the code listed in URL http://www.rondebruin.nl/win/s1/notes/notes5.htm . I am using excel 2010 version..
I get the above error for the line "Dim Data As DataObject". Please help me out..
Second part is that in the active sheet I have a picture inserted "Picture 1" and I want that picture to be pasted in the email.
I am using the below vba code
I am trying to copy a range of cells and paste it in lotus notes email. I am using the code listed in URL http://www.rondebruin.nl/win/s1/notes/notes5.htm . I am using excel 2010 version..
I get the above error for the line "Dim Data As DataObject". Please help me out..
Second part is that in the active sheet I have a picture inserted "Picture 1" and I want that picture to be pasted in the email.
I am using the below vba code
Code:
Public FolderName As String
Public WhereToSave As String
Public FilterSheet As Worksheet, OutPutSheet As Worksheet, OutPutWorkbook As Workbook, FilterWorkbook As Workbook, RowsOfDataSelected As Long
Public Sub FilterResultsAndSaveAsJPEG()
Dim TempFilePath As String
TempFilePath = Environ$("temp") & "\"
Dim TempFileName As String
Dim FileExtStr As String
Set FilterSheet = ActiveSheet
Set FilterWorkbook = ThisWorkbook
Workbooks.Add
Set OutPutWorkbook = ActiveWorkbook
Set OutPutSheet = ActiveSheet
FilterSheet.Range("S4").CurrentRegion.Copy
Range("A1").Select
With Selection
.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlPasteColumnWidths
.PasteSpecial Paste:=xlPasteValues
.Font.Size = 9
.Name = "Calibri"
End With
Application.CutCopyMode = False
With OutPutSheet
.Activate
ActiveWindow.Zoom = 74
RowsOfDataSelected = .Range("E4", .Range("E10000").End(xlUp)).Rows.Count
.Range("E4", .Range("E10000").End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"K1"), Unique:=True
End With
Dim HowManyIndustries As Excel.Range, Cell As Variant, FilterRange As Excel.Range, FieldNum As Integer, rng As Range
Dim NewWs As Worksheet
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim vaRecipient As Variant
Dim rnBody As Range
Dim Data As DataObject
Set HowManyIndustries = OutPutSheet.Range("K2", Range("K2").End(xlDown))
Set FilterRange = OutPutSheet.Range("A4:I" & (RowsOfDataSelected + 5))
FieldNum = 5
For Each Cell In HowManyIndustries
OutPutSheet.Activate
FilterRange.AutoFilter Field:=FieldNum, Criteria1:=Cell.Value
With Selection
On Error Resume Next
Set rng = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
Set NewWs = Sheets.Add
NewWs.Name = Cell.Value
rng.Copy
With Selection
.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlPasteColumnWidths
.PasteSpecial Paste:=xlPasteValues
.Font.Size = 9
.Name = "Calibri"
On Error Resume Next
Set rnBody = Selection
Application.CutCopyMode = False
ActiveWindow.Zoom = 74
End With
' FolderName = Format(Now, "yyyy-mm-dd h-mm-ss")
' If Len(Dir(TempFilePath, vbDirectory)) = 0 Then
' MkDir TempFilePath
' End If
'
' If Len(Dir(TempFilePath & FolderName, vbDirectory)) = 0 Then
' MkDir TempFilePath & FolderName
' End If
'
' WhereToSave = TempFilePath & FolderName
Const stSubject As String = "LS Enterprise LT$10M signings optimization"
Dim stMsg As String
stMsg = FilterSheet.Range("AC5").Value
'This is one technique to send an e-mail to many recipients but for larger
'number of recipients it's more convenient to read the recipient-list from
'a range in the workbook.
vaRecipient = FilterSheet.Range("AC3").Value
On Error GoTo 0
'Instantiate Lotus Notes COM's objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'Make sure Lotus Notes is open and available.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the document for the e-mail.
Set noDocument = noDatabase.CreateDocument
'Copy the selected range into memory.
rnBody.Copy
'Retrieve the data from then copied range.
Set Data = New DataObject
Data.GetFromClipboard
'Add data to the mainproperties of the e-mail's document.
With noDocument
.Form = "Memo"
.SendTo = vaRecipient
.Subject = stSubject
'Retrieve the data from the clipboard.
.Body = Data.GetText & " " & stMsg
.SaveMessageOnSend = True
End With
'Send the e-mail.
With noDocument
.PostedDate = Now()
.Send 0, vaRecipient
End With
'Release objects from memory.
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
'Activate Excel for the user.
AppActivate "Microsoft Excel"
'Empty the clipboard.
Application.CutCopyMode = False
Next Cell
End Sub