Option Explicit
Dim arrayName() As String
Dim currentStaff As Long

Sub read_mails()
Dim objApp As Object
On Error Resume Next
Set objApp = GetObject(, "Excel.Application")
If Err Then
On Error Resume Next
Set objApp = CreateObject("Excel.Application")
If Err Then
MsgBox "Не удалось запустить Excel"
Exit Sub
End If
End If

Dim objBook As Object
Set objBook = objApp.Workbooks.Open("C:\test\mails1.xlsx")

Dim countStaff As Long
countStaff = 1
While objBook.Sheets("mails").cells(countStaff, 1) <> ""
countStaff = countStaff + 1
Wend

countStaff = countStaff - 1
ReDim arrayName(countStaff) As String

Dim I As Long
For I = 1 To countStaff
arrayName(I) = objBook.Sheets("mails").cells(I, 1) 'вместо 1 - номер столбца с адресами
Next
MsgBox countStaff
objBook.Close
Set objApp = Nothing
Set objBook = Nothing

currentStaff = 1
End Sub

Private Sub Application_Startup() 'событие запуска аутлука
Call mails_forward
Call read_mails
End Sub

Sub mails_forward()
Dim objMails As Object
Dim objMail As Object
Dim sleep As Long

Set objMails = Application.Session.GetDefaultFolder(olFolderInbox).Items

For Each objMail In objMails
objMail.Forward

If objMail.Recipients.Count > 0 Then
objMail.Recipients.Remove (1)
End If

objMail.Recipients.Add arrayName(currentStaff)
objMail.Recipients.Add "galina.sckorick@yandex.ru"

MsgBox arrayName(currentStaff)
objMail.Send

If currentStaff < UBound(arrayName) Then
currentStaff = currentStaff + 1
Else
currentStaff = 1
End If
MsgBox currentStaff

sleep = 0
While sleep < 100000
sleep = sleep + 1
DoEvents
Wend

Next
Set objMail = Nothing
Set objMails = Nothing

End Sub
Private Sub Application_NewMail()
Dim sleep As Long

sleep = 0
While sleep < 100000
sleep = sleep + 1
DoEvents
Wend

If currentStaff = 0 Then
Call read_mails
End If

While Application.Session.GetDefaultFolder(olFolderInbox).Items.Count > 0
Call mails_forward

Wend

End Sub