send outlook e-mail using vba

[caspermurphy]

Good day,

I have this workbook that stores the file name and the user id and saves it to share drive. If they made an error, It gives them a chance to e-mail a message to have that workbook deleted.

Once they click on yes to delete the workbook, a new mail message is created, with To, Subject and a message typed in. It also picks up the cells g4-i4 and puts them in the body of the e-mail and then sends the e-mail out automaticaly.

This works fine on several PC's, however when it is used on others, it does not always bring the new e-mail message to the front, it is under another application that is open, word, internet explorer etc.. It seems to get hung at the point where it should be sent.

We use many different apps at the same time, so closing them is not an option.

We use office 2003 on windows 2000 professional.

Here is the code that I have now.

I use the sendkeys option because I do not get a window stating that another application is trying to send an e-mail. I can work with that, if need be.

If this is to long, I apologize in advance.

Also, thank you for any help that might be out there.

John

Sub SendRange()

'Sends a specified range in an Outlook message and retains Excel formatting

'Dimension variables
Dim oOutlookApp As Object, oOutlookMessage As Object
Dim oFSObj As Object, oFSTextStream As Object
Dim rngeSend As Range, strHTMLBody As String, strTempFilePath As String
Dim MYName As String

'initialize MYName to user
Windows("workbook 0512.xls").Activate
Application.ScreenUpdating = False
Sheets("2005 1").Select

' gets user name to use in message box
Range("f73").Select
MYName = ActiveCell.Value

'this will make cells g4:I4 bevisible to copy infor from. It was hidden by the color of the font(white, will turn to black)
Range("G73").Select
ActiveCell.Value = 1
Range("c6").Select
Application.ScreenUpdating = True

'Select the range to be sent
'On Error Resume Next
'Set rngeSend = Application.InputBox(Prompt:="Please select range you wish to send.", _
'Type:=8, Default:=Selection.Address)

'If rngeSend Is Nothing Then Exit Sub 'User pressed Cancel
'On Error GoTo 0

If MsgBox(MYName & ", Are you sure you want to have this workbook deleted? " & _
"By clicking yes, you are stating that you would like the workbook that you JUST saved to be deleted. ", _
vbYesNo, "WORKBOOK DELETED") = vbNo Then Exit Sub

'It will unprotect workbook
Application.Run "'workbook 0512.xls'!Unprotect1"

'Select the range to be sent
On Error Resume Next
Set rngeSend = ActiveSheet.Range("g4:I4")
If rngeSend Is Nothing Then Exit Sub 'User pressed Cancel
On Error GoTo 0


'Get the temp folder path
Set oFSObj = CreateObject("Scripting.FilesystemObject")
strTempFilePath = oFSObj.GetSpecialFolder(2)
strTempFilePath = strTempFilePath & "\XLRange.htm"


'Now create the HTML file - NOTE! xlSourceRange and xlHtmlStatic have been replaced by their
'numeric values due to a potential error (unexplained) noted by Ivan F Moala 15/5/03
ActiveWorkbook.PublishObjects.Add(4, strTempFilePath, _
rngeSend.Parent.Name, rngeSend.Address, 0, "", "").Publish True

'Create an instance of Outlook (or use existing instance if it already exists
Set oOutlookApp = CreateObject("Outlook.Application")

'Create a mail item
Set oOutlookMessage = oOutlookApp.CreateItem(0)

'Open the HTML file using the FilesystemObject into a TextStream object
Set oFSTextStream = oFSObj.OpenTextFile(strTempFilePath, 1)

'Now set the HTMLBody property of the message to the text contained in the TextStream object
strHTMLBody = oFSTextStream.ReadAll

'By default the range will be centred. This line left aligns it and you can
'comment it out if you want the range centred.
strHTMLBody = Replace(strHTMLBody, "align=center", "align=left", , , vbTextCompare)

oOutlookMessage.HTMLBody = strHTMLBody

oOutlookMessage.Display

With oOutlookMessage
.To = "bcajpk"
' .Cc = "Cc to person"
' .Bcc = "Bcc to person"
.Subject = "DELETE WORKBOOK"
' .Body = "Please delete the following workbook, I have made the following mistake:"
' .Attachments.Add "C:\add filepath here"
.Display 'change to .Send if you don't want displayed
End With
'Application.SendKeys
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True
SendKeys "Please delete the following workbook, it contains errors. Thank you.", True
SendKeys ("%s")
Windows("workbook 0512.xls").Activate
Application.ScreenUpdating = False
Sheets("2005 1").Select
Range("g67").Select
Selection.ClearContents
Range("g73").Select
Selection.ClearContents
Range("c6").Select
Application.ScreenUpdating = True
Application.Run "'workbook 0512.xls'!Protect1"
End Sub

 

[BrianB]

It looks to me that your code is in the wrong order. I always put the line

oOutlookMessage.Display

as the very last in the subroutine. This gives the user the opportunity to check the email before clicking send.

You are doing things in Excel after this line, so it will retain focus - especially as you are using Select.

 

[caspermurphy]

Brian,

that seemed to do the trick, thank you.

John