Mail from Excel - With attachment

[mangeshp4]

Hi I want to send mail from excel . for which below code works fine. am looking to midify this to ..
1] I want to copy data from excel & paste in Lotus Body
2} I want to send mail with attachment.

Private Sub CommandButton1_Click()
Dim s As Object
Dim db As Object
Dim doc As Object
Dim nSession
Set us1 = Range("g6:i24")
Set s = CreateObject("Notes.NotesSession")
Set db = s.GetDatabase(" ", "mail\username.nsf")
Set doc = db.createdocument()
doc.form = "Memo"
doc.sendTo = "[email protected]"
doc.Subject = " Sending Mail from EXCEL MACRO"
doc.body = us1 '" Hi Pranali Sending Mail from EXCEL MACRO"
Call doc.Send(False)
Set nSession = Nothing

End Sub

[JOHN H. DAVIS]

See if this can help you with an attachment?

Private Sub CommandButton1_Click()
Dim s As Object
Dim db As Object
Dim doc As Object
Dim Attachment1 As String
Dim AttachME As Object
Dim EmbedObj1 As Object
Dim nSession
Set us1 = Range("g6:i24")
Set s = CreateObject("Notes.NotesSession")
Set db = s.GetDatabase(" ", "mail\username.nsf")
Set doc = db.createdocument()
doc.form = "Memo"
doc.sendTo = "[email protected]"
doc.Subject = " Sending Mail from EXCEL MACRO"
doc.body = us1 '" Hi Pranali Sending Mail from EXCEL MACRO"
Attachment1 = "C:\YOUR PATH\YOUR FILE.xls" '"C:\YourFile.xls" ' Required File Name

If Attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
Set EmbedObj1 = AttachME.embedobject(1454, "attachment1", "C:\YOUR PATH\YOUR FILE.xls", "") 'Required File Name
On Error Resume Next
End If

Call doc.Send(False)

Set nSession = Nothing
Set AttachME = Nothing
Set EmbedObj1 = Nothing
Set db = Nothing
Set doc = Nothing

End Sub

Does us1 take care of your first request?

[mangeshp4]

1] us1 doesn't work it sent a blank mail w/o excel pasting.
2] code given by you also sends blank mail w/o attachment.

[JOHN H. DAVIS]

Did you change the Path in the example I provided? The Path should be to the file which is to be attached. I though you had tested US1. I can help you with a couple of cells, but I can't with a range of cells as you indicated. Example doc.Body = Range("G6").Text & " " & Range("H6").Text will give the data in those two ranges.

[mangeshp4]

Yes I have change path still it sends a blank mail. refer code below.

Private Sub CommandButton2_Click()
Dim s As Object
Dim db As Object
Dim doc As Object
Dim Attachment1 As String
Dim AttachME As Object
Dim EmbedObj1 As Object
Dim nSession
Set us1 = Range("g6:i24")
Set s = CreateObject("Notes.NotesSession")
Set db = s.GetDatabase(" ", "mail\username.nsf")
Set doc = db.createdocument()
doc.form = "Memo"
doc.sendTo = "[email protected]"
doc.Subject = " Sending Mail from EXCEL MACRO"
doc.body = Range("G6").Text & " " & Range("H6") 'us1
Attachment1 = "C:\log.txt" '"C:\YourFile.xls" ' Required File Name
If Attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment1")
Set EmbedObj1 = AttachME.embedobject(1454, "Attachment1", "C:\log.txt", "") 'Required File Name
On Error Resume Next
End If

Call doc.Send(False)

Set nSession = Nothing
Set AttachME = Nothing
Set EmbedObj1 = Nothing
Set db = Nothing
Set doc = Nothing

End Sub

[JOHN H. DAVIS]

This line was used as a sample if you do not have data there, then there will be no results.

doc.body = Range("G6").Text & " " & Range("H6")

Also Range("H6") should be Range("H6").Text

Try changing this line:

Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment1")

To this:

Set AttachME = doc.CREATERICHTEXTITEM("Attachment1")

[mangeshp4]

I hv got it solved for sending attachment , but pending for pasting excel content

Private Sub CommandButton3_Click()
    Dim oSess As Object
    Dim oDB As Object
    Dim oDoc As Object
    Dim oItem As Object
    Dim direct As Object
    Dim Var As Variant
    Dim flag As Boolean
     
    Set oSess = CreateObject("Notes.NotesSession")
    Set oDB = oSess.GETDATABASE("", "")
    Call oDB.OPENMAIL
    flag = True
    If Not (oDB.IsOpen) Then flag = oDB.Open("", "")
     
    If Not flag Then
        MsgBox "Can't open mail file: " & oDB.SERVER & " " & oDB.FILEPATH
        GoTo exit_SendAttachment
    End If
    On Error GoTo err_handler
     
     'Building Message
    Set oDoc = oDB.CREATEDOCUMENT
    Set oItem = oDoc.CREATERICHTEXTITEM("BODY")
    oDoc.Form = "Memo"
    oDoc.Subject = "Subject in here"
    oDoc.sendto = "[email protected]"
    oDoc.BODY = ""
    oDoc.postdate = Date
    oDoc.SaveMessageOnSend = True
     
     'Attaching DATABASE
    Call oItem.EmbedObject(1454, "", "c:\test\cws.xls")
    oDoc.visable = True
     'Sending Message
    oDoc.SEND False
exit_SendAttachment:
    On Error Resume Next
    Set oSess = Nothing
    Set oDB = Nothing
    Set oDoc = Nothing
    Set oItem = Nothing
     'Done
    Exit Sub
err_handler:
    If Err.Number = 7225 Then
        MsgBox "File doesn't exist"
    Else
        MsgBox Err.Number & " " & Err.Description
    End If
    On Error GoTo exit_SendAttachment
End Sub