Reg: Excel file autosending email using Microsoft Outlook

Hi All,

I am new to VBA and trying to learn the nitty-gritty of excel vba. My query is that I am trying to send an email automatically from my excel sheet through outlook 2007 application. It is a simple macro which checks for the condition for the first cell in row while using two other cell in the same row as email id and message bidy. The issue that I am facing is the loop which according to me is pretty simple but still it is giving the error "The object has been moved/deleted" while executing and sending the email successfully for the first cell in the range (Cells_M).

Sub SendMail()

    Dim olApp As Outlook.Application
    Dim olMail As MailItem
    Dim Cell As Range
    Dim Cells_M As Range
    
        Set olApp = New Outlook.Application
        Set olMail = olApp.CreateItem(olMailItem)
    
        ActiveWorkbook.Save
    
        Set Cells_M = Range("A4:A6")
        
        For Each Cell In Cells_M
        
            If Cell.Value > Date Then
        
                With olMail
                    .To = Cell.Offset(0, 4).Value 'I have tried Cell.Offset(0, 4).text also but same error". This cell has the email id
                    .Subject = "Pending Reports"
                    .Body = Cell.Offset(0, 1).Text 'This cell has text or the report which is pending
                    .Send
                End With
        
            Else
                
            End If
        
            Next Cell

    Set olMail = Nothing
    Set olApp = Nothing

End Sub

Hi abhimails

Welcome to the Forum!!!

I'm not able to duplicate the issue but you may wish to move the two lines of Code as indicated.

Option Explicit

Sub SendMail()

  Dim olApp As Outlook.Application
  Dim olMail As MailItem
  'Dim Rng As Date
  Dim Cell As Range
  Dim Cells_M As Range

  '          Set olApp = New Outlook.Application       '<---Move this line
  '          Set olMail = olApp.CreateItem(olMailItem) '<---Move this line

  '  ActiveWorkbook.Save

  'Rng = ActiveSheet.Range("A2")

  Set Cells_M = Range("A2:A10")

  For Each Cell In Cells_M

    If Cell.Value > Date Then
      Set olApp = New Outlook.Application       '<-----to here
      Set olMail = olApp.CreateItem(olMailItem) '<-----to here
      With olMail
        .To = Cell.Offset(0, 4).Value
        '.CC = "[email protected]"
        .Subject = "Pending Reports"
        .Body = Cell.Offset(0, 1).Text
        .Send
        '        .Display
      End With

    Else

    End If

    'MsgBox ("Criteria not met")

  Next Cell

  Set olMail = Nothing
  Set olApp = Nothing

End Sub

You're welcome...glad I could help.

If you're satisfied by any members response to your issue please use the star icon at the lower left of their post.