PDA

View Full Version : [SOLVED:] sending an email from the file location



bacon
08-31-2005, 02:51 AM
Good Morning guys and gals...

Need a little advice please...

I have a spreadsheet that is worked on by 4-5 different people... At the end of each day at approx 6pm I need to send the spreadsheet to a number of people.
What i would like to be able to do is for an email to open, attach the excel spreadsheet (the spreadsheet will be closed so will need to pick it up from its file locations) then send it to a number of people. All this needs to be done at 6pm...

Is this possible or am I looking at extending my working hours to cover this boring task ;)

Any help would be appreciated

Cheers


Bacon

austenr
08-31-2005, 06:20 AM
You will have to adapt this to your email type. Outlook, Lotus Notes etc. Also you may have to change the sheet name and range. Currently this code uses Lotus Notes. I have attached a zip file with instructions. HTH




Option Explicit

Sub MaillWorkbook()
Dim EmailSubject As String 'Email Subject Line
Dim UserEmail As String 'The email address that is being sent to
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 AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
Dim Subject As String 'The subject string
Dim Attachment As String 'The path to the attachemnt string
Dim Recipient As String 'The Recipient string (or you could use the list)
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
'open to determine if session should be
'closed (0) or left alone (1)
Dim ClipBoard As DataObject 'Data object for getting text from clipboard
UserEmail = InputBox(PROMPT:="Please enter recipient email address")
EmailSubject = InputBox(PROMPT:="Please enter subject line")
Subject = EmailSubject
Recipient = UserEmail 'Copying it to Clipboard
Sheets("Sheet1").Select
Range("A1:z9000").Select
Selection.Copy
Set ClipBoard = New DataObject
ClipBoard.GetFromClipboard
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
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.sendto = Recipient 'Or use Racip(10) for multiple
MailDoc.Subject = Subject
MailDoc.body = ClipBoard.GetText(1)
MailDoc.SAVEMESSAGEONSEND = SaveIt
If Attachment <> "" Then
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
MailDoc.CREATERICHTEXTITEM ("Attachment")
End If
MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
MailDoc.SEND 0, Recipient
'Clean Up
Range("A1").Select
Application.CutCopyMode = False
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set EmbedObj = Nothing
If WasOpen = 1 Then
Set Session = Nothing
ElseIf WasOpen = 0 Then
Session.Close
Set Session = Nothing
End If
MsgBox "The Email was sent successfully!!", vbOKOnly
End Sub

bacon
08-31-2005, 07:23 AM
many thanks :)