PDA

View Full Version : open Microsoft windows mail and attach



specops
01-04-2011, 06:53 AM
In the past we created an automated report sheet in excel which;
1 checked all the cells had been completed
2 saved itself in excel to the laptop hard drive with a unique file name from information inputtted to key cells
3 used CutePDF to convert itself to PDF, then saved a PDF copy to the Laptop hard drive
4 the code then opened the email system we used called Lotus Notes and created a new email and attached the PDF copy to the email and filled in the subject line with the unuque file name.

My problem is now we what to use the sheet with Microsoft Windows Mail but the person who created the original sheet has left the company.

I need to change the code to open microsoft windows mail and do the same things is used to do in Lotus Notes.

I have attached the code for email part of the sheet.



Sub SendWithLotus()
Dim MaximoNum As String
Dim todayDate As String
Dim jobLoc As String
Dim docType As String
Dim Title As String
Dim workpath As String
Dim WorkPath2 As String
Dim contract As String
Dim SaveName As String
Dim Serial1 As String
Dim Serial2 As String
Dim Serial3 As String
Dim Serial4 As String
Dim SerialNo As Integer
Dim Engineer As String
Dim BBWSite As String
Dim ObjWSH As Object
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim obAttachment As Object, EmbedObject As Object
Dim stSubject As Variant, stAttachment As String
Dim vaRecipient As Variant, vaMsg As Variant
Dim vaRecipient2 As String

Const EMBED_ATTACHMENT As Long = 1454
Const stTitle As String = "Active workbook status"

Do
vaRecipient = Application.InputBox( _
Prompt:="Please enter full email address of receipient below." & vbCrLf _
& "Please make sure that LOTUS NOTES IS OPEN before pressing OK", _
Title:="Recipient", Default:="", Type:=2)
Loop While vaRecipient = ""
'If the user has canceled the operation.
If vaRecipient = False Then Exit Sub
'This message gives the details of the job.
MaximoNum = Range("B100").Value
contract = Range("W10").Value
Serial1 = Range("B104").Value
Serial2 = Range("B105").Value
Serial3 = Range("B106").Value
Serial4 = Range("B107").Value
SerialNo = Range("B108").Value
jobLoc = Range("B102").Value
todayDate = Range("B103").Value
todayDate = Format(Date, "dd-mm-yy")
docType = Range("B101").Value
Title = Range("B109").Value
Engineer = Range("B110").Value
BBWSite = Range("B111").Value
vaMsg = "Please find attached: " & vbCrLf _
& vbCrLf _
& "Form: " & Title & vbCrLf _
& "Maximo Number: " & MaximoNum & vbCrLf _
& "Date: " & todayDate & vbCrLf _
& "Location: " & jobLoc & vbCrLf _
& vbCrLf _
& "Test Equipment Number: " & SerialNo & vbCrLf _
& "Serial numbers: " & vbCrLf _
& "Analyser: " & Serial1 & vbCrLf _
& "Manometer: " & Serial2 & vbCrLf _
& "Manometer: " & Serial3 & vbCrLf _
& "Other: " & Serial4 & vbCrLf _
& vbCrLf _
& "Engineer: " & Engineer _
& vbCrLf _
& "BBW site?: " & BBWSite
'Add the subject to the outgoing e-mail
stSubject = MaximoNum & "-" & contract & "-" & jobLoc & "-" & todayDate & "-" & docType
'Retrieve the path and filename of the active workbook.
'WorkPath2 = "D:\My Documents\Gas Sheets email"
Set ObjWSH = CreateObject("WScript.Shell")
WorkPath2 = ObjWSH.SpecialFolders.Item("MyDocuments")
stAttachment = WorkPath2 & "\" & "Gas Sheets Email" & "\" & MaximoNum & "_" & contract & "_" & jobLoc & "_" & todayDate & "_" & docType & ".pdf"
MsgBox "You are about to email the following file: " & stAttachment
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set obAttachment = noDocument.CreateRichTextItem("stAttachment")
Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipient
.CC = vaRecipient2
.Subject = stSubject
.Body = vaMsg
.SaveMessageOnSend = True
End With
'Send the e-mail.
With noDocument
.PostedtodayDate = Now()
.Send 0, vaRecipient
End With

'Release objects from the memory.
Set EmbedObject = Nothing
Set obAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing

'Activate Excel for the user.
AppActivate "Microsoft Excel"
MsgBox "The e-mail has successfully been created and distributed.", vbInformation
End Sub

Simon Lloyd
01-04-2011, 09:00 AM
Check out xlDennis' site here http://www.excelkb.com/?cNode=1X5M7A

specops
01-04-2011, 09:19 AM
Simon

I was little surprised at your reply to my post having followed the link on cross posting.

I am a complete novice on VBA and was only asking for some assistance, i am still not even sure what cross posting is or why you felt i was doing it?

i have only ever used vbaexpress.

Bob Phillips
01-04-2011, 11:38 AM
I don't think Simon is accusing you of cross-posting, that is just a line in his signature, it appears on all his posts. He gave you a suggested solution/help in the link to xlDennis' site.

Simon Lloyd
01-04-2011, 01:22 PM
Thanks xld :)
Even though it appears after my sign off "Regards...." i think perhaps i should add a solid line to further show the segregation.

Specops, the link i proposed to xlDennis' site will get you where you want to be with this problem ;)