I'm creating a macro to pull data off a sheet, "Dashboard", and send it to team members. The email itself generates properly, but the macro runs constantly after I press the button, creating unlimited amounts of email drafts in Outlook until I exit Excel. The formula in VBA is below. Would anyone be able to help identify the reason for the macro running over and over?
Dim objOutApp As Object, objOutMail As Object Dim strBody As String, strSig As String Dim olMailItm As Object Dim iCounter As Integer Dim Dest As Variant Dim SDest As String Dim rng As Range
Set rng = Nothing On Error Resume Next 'Only the visible cells in the selection 'rws = ActiveSheet.UsedRange.Rows.Count 'cols = ActiveSheet.UsedRange.Columns.Count 'Set rng = Range(Cells(1, 1), Cells(rws, cols)) ' rng.Select 'You can also use a fixed range if you want Set rng = Sheets("Dashboard").Range("B21:H78").SpecialCells(xlCellTypeVisible) On Error GoTo 0
If rng Is Nothing Then MsgBox "The selection is not a range or the sheet is protected" & _ vbNewLine & "please correct and try again.", vbOKOnly Exit Sub End If
With Application .EnableEvents = False .ScreenUpdating = False End With
For iCounter = 1 To WorksheetFunction.CountA(Columns(1)) Set objOutApp = CreateObject("Outlook.Application") Set objOutMail = objOutApp.CreateItem(0)
'CHECK NAMES, ENSURES INTERNAL EMAIL ADDRESSES EXISTS IN ADDRESS BOOK .Recipients.ResolveAll
'DO NOT REMOVE - THIS MUST BE VISIBLE FIRST TO GET THE DEFAULT SIGNATURE .Display
'GET THE HTML CODE FROM THE SIGNATURE strSig = .HTMLBody
'WHAT SHOULD THE EMAIL SAY, ON TOP OF THE SIGNATURE 'HTML TAGS CAN BE INCLUDED HERE strBody = ""
'strBody = "<font face=Tahoma size=3> This is what I want the email to say. </calibri> <p>" & _ '"<font color=green> For additional support, tips, or Excel consultation, " & _ '"please visit: <a href=http://www.formatcells.com> formatcells.com.</a></font>"
strBody = "<font face=Calibri size=3> Hi Team " & ", <p>" & _ "Below is our scorecard reporting for the timeframe listed above, including current and month to date snapshots. Please let me know if you have any questions." & vbCrLf strBody = strBody & RangetoHTML(rng) & vbCrLf strBody = strBody & strSig
'COMBINE THE EMAIL WITH THE SIGNATURE .HTMLBody = strBody
'IF YOU DO NOT HAVE HTML IN THE BODY, USE THIS INSTEAD '.Body = strBody & strSig
'AUTOMATICALLY SEND EMAIL (IT WILL STILL BRIEFLY POPUP) '.Send
On Error GoTo 0 Set objOutMail = Nothing Set objOutApp = Nothing