Assuming column A has a header row, then the following should work when run from a rule. I have included a test macro.
Change the workbook and worksheet names as appropriate in the line
Arr = xlFillArray("C:\Path\Distribution List.xlsx", "Sheet1").
The process reads the worksheet into an array and then using an incrementing counter the macro forwards the message to the next e-mail address.
The counter is stored in the registry at HKEY_CURRENT_USER\Software\VB and VBA Program Settings\OutlookDistributeMessages. I have added a macro to allow you to test the code,
Option Explicit
Sub Test()
Dim olMsg As MailItem
On Error Resume Next
Set olMsg = ActiveExplorer.Selection.Item(1)
DistributeMessages olMsg
lbl_Exit:
Exit Sub
End Sub
Sub DistributeMessages(olItem As MailItem)
Dim olOutMail As Outlook.MailItem
Dim sAddr As String
Dim iCount As Long
Dim i As Long
Dim Arr() As Variant
Arr = xlFillArray("C:\Path\Distribution List.xlsx", "Sheet1")
iCount = Val(GetSetting("OutlookDistributeMessages", "Config", "Count"))
sAddr = Arr(0, iCount)
iCount = iCount + 1
Set olOutMail = olItem.Forward
With olOutMail
.To = sAddr
.Display 'Change to .Send after testing
End With
If iCount = UBound(Arr, 2) + 1 Then iCount = 0
SaveSetting "OutlookDistributeMessages", "Config", "Count", CStr(iCount)
olItem.Move Session.GetDefaultFolder(olFolderInbox).folders("Done")
lbl_Exit:
Set olOutMail = Nothing
Exit Sub
End Sub
Private Function xlFillArray(strWorkBook As String, _
strWorksheetName As String) As Variant
Dim RS As Object
Dim CN As Object
Dim iRows As Long
strWorksheetName = strWorksheetName & "$]"
Set CN = CreateObject("ADODB.Connection")
CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkBook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
Set RS = CreateObject("ADODB.Recordset")
RS.Open "SELECT * FROM [" & strWorksheetName, CN, 2, 1
With RS
.MoveLast
iRows = .RecordCount
.MoveFirst
End With
xlFillArray = RS.GetRows(iRows)
If RS.State = 1 Then RS.Close
Set RS = Nothing
If CN.State = 1 Then CN.Close
Set CN = Nothing
lbl_Exit:
Exit Function
End Function