Add confirmation to button press

August 4, 2010 at 05:43:50
Specs: xp, 4gb
Hi, I found the following piece of VB code that allows me to create a button in Excel and send a worksheet in the body of an email. It works great but the only problem is that when the button is pressed the email goes out without giving the user any type of indication that it went out, so I suspect users will hit it several times, resulting in duplicate emails.

Can anyone please provide a snippet of code that will generate some type of popup or confirmation once the button is pressed?

Sub Mail_Sheet_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set rng = Nothing
Set rng = ActiveSheet.UsedRange
'You can also use a sheet name
'Set rng = Sheets("YourSheet").UsedRange

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Assistance Request"
.HTMLBody = RangetoHTML(rng)
.Send 'or use .Display
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copy the range and create a new workbook to past the data in
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
On Error GoTo 0
End With

'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
.Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function


See More: Add confirmation to button press

August 4, 2010 at 08:46:58

You could just use MsgBox

MsgBox "Your email has been sent"

This is limited, in that it does not actually test that the email 'send' was successful, but it does give an indication that the macro ran.

Instead of On Error Goto 0, you could have:
On Error Goto ErrHnd:


Set OutMail = Nothing
Set OutApp = Nothing
Exit Sub
'error handler
Application.ScreenUpdating = True
msgbox "There was a problem with this program ..."
End Sub

to warn users that the code did not complete normally.

I note that you have Application.EnableEvents=False
at the start of the code. As this code is being run from a button, this command is not required.

If your code crashed, you would be left with Events disabled - and no warning that this was the case. I suggest that you remove the two EnableEvents lines.


Report •
Related Solutions

Ask Question