PDA

View Full Version : Send email with attached file (vba)



raraya
03-17-2006, 02:35 PM
Helo everyone:

I need some help to create a VBA code in excel that open outlook and attaching a file *.htm.
I dont need the workbook just the *.htm file.-

Thank so much .-

Raraya

matthewspatrick
03-17-2006, 03:36 PM
Raraya,

That is fairly simple:


Sub SendMessage()

Dim olApp As Object
Dim olMgs As Object

Set olApp = CreateObject("Outlook.Application")
Set olMsg = olApp.CreateItem(0)

With olMsg
.Subject = "some subject"
.Body = "some body text"
.To = "someone@someplace.com"
.Attachments.Add "c:\folder\subfolder\file.thm"
.Send
End With

Set olMsg = Nothing
Set olApp = Nothing

End Sub



Of course, if you have Office 200 SP2 or later, you may have the Outlook automation security warning to deal with...

debauch
03-17-2006, 04:41 PM
You think the " .Attachments.Add "c:\folder\subfolder\file.thm" " would work with Lotus ? That would save me a lot of time .... hmm ....

debauch
03-17-2006, 04:55 PM
Didn't work .... could you maybe try and help me w/ this one?


Private Sub lotus()
'On Error Resume Next
'single Request
Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDbName As String 'The current users notes mail database name
Dim maildoc As Object 'The mail document itself
Dim Session As Object 'The notes session
Dim Subject As String 'The subject string
Dim ReturnReceipt As String 'The ReturnReceipt string
Dim Recipient As String 'The Recipient string (or you could use the list)
Dim ccPerson As String
Dim Recip(10) As Variant 'The Recipient list
Dim BodyText As String 'The body text
Dim SaveIt As Boolean 'Save to sent mail
Dim WasOpen As Integer 'Checking to see if the Mail DB was already
Dim ClipBoard As DataObject
Dim attachments As Object ' <<<<<<<< Is this what I would add?

Subject = "Single Request From " & Sheets("sheet1").Range("B2").Value & _
" For " & Sheets("sheet1").Range("B6").Value & "'s " & _
Sheets("Sheet1").Range("B10").Value ' " Request"
'put name if distro
Recipient = "Workgroupinbox@company.com"
ccPerson = txtCCPerson.Text

SaveIt = True
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
WasOpen = 1 'Already open for mail
Else
WasOpen = 0
Maildb.OPENMAIL 'This will prompt you for password
End If

Sheets("sheet1").Activate
Sheets("Sheet1").Range("A1:b13").Select
'Range("A1:B13").Select
Selection.Copy

Set ClipBoard = New DataObject
ClipBoard.GetFromClipboard

Set maildoc = Maildb.CREATEDOCUMENT
maildoc.Form = "Memo"
maildoc.sendto = Recipient
maildoc.copyto = ccPerson
maildoc.Subject = Subject
maildoc.body = ClipBoard.GetText
maildoc.attachments.Add "C:\test.txt" ' <<<< added this in ...
maildoc.ReturnReceipt = "1"
maildoc.SAVEMESSAGEONSEND = SaveIt
maildoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
maildoc.Send 0, Recipient 'this sends memo


End Sub

mdmackillop
03-17-2006, 06:15 PM
Hi Debauch
Can you please insert linebreaks in your posted code as scrolling long lines is a bit of a nuisance.
Regards
MD

debauch
03-17-2006, 06:16 PM
Sorry mdm, Im not sure I know what u mean. I can reduce it though .

mdmackillop
03-17-2006, 06:19 PM
At the moment, your code needs to be scrolled. This can be a problem for those with a small screen resolution. If you break the code using the underscore character, this can be avoided. I'll edit it for you.
Regards
MD

Ivan F Moala
03-18-2006, 05:30 AM
Have a look here
http://www.xcelfiles.com/LotusNotes02.html

debauch
03-27-2006, 04:23 PM
I know this wasn't really my thread, so thanks Ivan, and thanks mdm, I will line break from now on.

mdmackillop
03-27-2006, 10:29 PM
Is this solved?