Untere Array Grenze muss 0 sein

With ActiveWorkbook
Dim empf() As Variant
Dim n As Integer
n = 3
Do While Not Cells(n, 4) = ""
ReDim Preserve empf(n)
empf(n) = Cells(n, 4)
n = n + 1
Loop
'InitializeOutlook = True
Set MyOutApp = CreateObject("Outlook.Application")
'Nachrichtenobject erstellen
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = empf 
.Subject = "Lieferantenbewertung - Bitte um Durchführung"
'Attachment zugefügt
.Attachments.Add AWS
'Hier wird die HTML Mail erstellt
.Body = "Das ist ein Test." & vbCrLf & "Bitte ignorieren."
.Display
.Send
End With
End With