Home > database >  VBA: Opening Multiple Emails in Loop
VBA: Opening Multiple Emails in Loop

Time:01-11

Right now I have code which opens e-mail if ID given in user-form(TextBox1INC) is found in Column1, but let's say I have two e-mails or whatever the number is and I want to open all of them and not only one. How Do I put loop inside this code to make this work ?

Private Sub CommandButton8showemail_Click()

Dim wsArch As Worksheet
Dim lastrow, a As Long
Dim strEmail, strEmailLoc As String
Dim OutMejlik As Outlook.Application
Dim msg As Outlook.MailItem

Set wsArch = ThisWorkbook.Sheets("Emails_arch")
lastrow = Sheets("Emails_arch").Range("A" & Rows.Count).End(xlUp).Row

With wsArch
    For a = lastrow To 2 Step -1
        If .Cells(a, 1).Value = TextBox1INC.Text Then
        strEmailLoc = .Cells(a, 2).Value
        Set OutMejlik = CreateObject("Outlook.Application")
        Set msg = OutMejlik.Session.OpenSharedItem(strEmailLoc)
        msg.Display
        Exit Sub
        End If
    Next a
End With

End Sub

CodePudding user response:

Currently in the loop you are exiting as soon as the first item is displayed to a user:

    For a = lastrow To 2 Step -1
        If .Cells(a, 1).Value = TextBox1INC.Text Then
        strEmailLoc = .Cells(a, 2).Value
        Set OutMejlik = CreateObject("Outlook.Application")
        Set msg = OutMejlik.Session.OpenSharedItem(strEmailLoc)
        msg.Display
        Exit Sub
        End If
    Next a
End With

If you remove the Exit Sub part the code will continue running and opening items as you need. But also I'd recommend creating a new Outlook Application outside of the loop to avoid creation each time (even if Outlook is a singleton and only one instance can be created).

Set OutMejlik = CreateObject("Outlook.Application")

With wsArch
    For a = lastrow To 2 Step -1
        If .Cells(a, 1).Value = TextBox1INC.Text Then
          strEmailLoc = .Cells(a, 2).Value
         
          Dim msg As Outlook.MailItem
          Set msg = OutMejlik.Session.OpenSharedItem(strEmailLoc)
          msg.Display
        End If
    Next a
End With
  • Related