title: Outlook freezes when sending from Excel
body: <p>I'm really having trouble finding any answers for this problem. I have an Excel macro that filters a sheet (it's a basic order form), copies and emails a range using an Outlook object. The <strong>file worked</strong> for several weeks and ran quickly.</p>
  <p>Now all of the sudden whenever the macro is run the Excel portion of filtering and copying works fine but when it gets to the email code Outlook locks up, and I get a popup from Excel saying it's waiting for Outlook to complete an OLE action. I end up having to kill the Outlook process. I've tried early and late bindings.</p>
  <pre><code>Sub EmailOrder()
  
  Dim answer As Integer
  Dim lastRow As String
  Dim filteredRow
  Dim emailApp As Outlook.Application
  Dim emailItem As Outlook.MailItem
  Dim exportRange As Range
  Dim currentTime As String
  Dim currentUserEmailAddress As String
  
  answer = MsgBox(&quot;Click OK to send your order to the supply team&quot;, vbOKCancel)
  
      If answer = vbOK Then
          Worksheets(&quot;Sheet1&quot;).Activate
          
              lastRow = Cells(Rows.Count, 1).End(xlUp).Row
              currentTable = &quot;$A$1:$E$&quot; &amp; lastRow
              'Filter out blanks
              Range(currentTable).AutoFilter Field:=5, Criteria1:=&quot;&lt;&gt;&quot;
              
              Set exportRange = Nothing
              On Error Resume Next
              'Only the visible cells in the selection
              Set exportRange = Selection.SpecialCells(xlCellTypeVisible)
              
          'Setup outlook objects and mail
          Set emailApp = New Outlook.Application
          Set emailItem = emailApp.CreateItem(olMailItem)
          Set outSession = emailItem.Session.CurrentUser
          currentUserEmailAddress = outSession.AddressEntry.GetExchangeUser().PrimarySmtpAddress
          currentTime = Now
          
          'Write email
          With emailItem
          
          .To = &quot;redacted@gmail.com&quot;
          .CC = currentUserEmailAddress
          .Subject = &quot;Local Inventory Order &quot; &amp; currentTime
          .HTMLBody = RangetoHTML(exportRange)
          .Send
          End With
              
          'Close objects
          Set emailApp = Nothing
          Set emailItem = Nothing
          
          MsgBox (&quot;The order has been emailed to the supply team.&quot;)
      End If
  End Sub
  </code></pre>
  <p>The RangetoHTML function is from <a href="https://www.rondebruin.nl/win/s1/outlook/bmail2.htm" rel="nofollow noreferrer">Ron de Bruin's</a> website. Any help is appreciated.</p>
  <p>EDIT: failed to mention that there have been other users of the sheet who reported it working for several weeks then stopping.</p>