Schleifenproblem VBA
12.03.2016 13:54:49
Nik
ich habe hier aus dem Forum (als auch generell Google-Suche) mir VBA-Code zusammengesucht für den Versand von E-Mails aus Excel heraus in Outlook. Hat auch alles wunderbar soweit funktioniert. Als ich dem Code allerdings noch eine Schleife verpasst habe versendet er teils nur die ersten zwei Einträge und bringt mir folgede Meldung: "Laufzeitfehler '2147221238 (8004010a)': Das Element wurde verschoben oder gelöscht". Kapiere ich nicht wirklich :-(
Code:
Sub Outlookversand()
Dim x As Long
Dim objApp As Object
Dim objMailItem As Object
Dim Adress As Variant
Dim sAdress As String, sSubject As String
Dim sPfad As String
Dim sAttachements As String
Set objApp = CreateObject("Outlook.Application")
Set objMailItem = objApp.CreateItem(0)
For x = 1 To Worksheets("Datenbank Aktiv").Range("B110").End(xlUp).Row - 1
Worksheets("Rechnung").Range("O1") = x
sAdress = Worksheets("Rechnung").Range("k3").Value
sSubject = Worksheets("Rechnung").Range("k4").Value
sText = Worksheets("Rechnung").Range("k5").Value
sPfad = Worksheets("Rechnung").Range("k1")
With objMailItem
.To = sAdress
.Subject = sSubject
.body = sText
.Attachments.Add sPfad & "\" & Worksheets("Rechnung").Range("k2")
.OriginatorDeliveryReportRequested = True
.ReadReceiptRequested = True
Set .SendUsingAccount = .Session.Accounts.Item("Imkerverein Randen")
.send
End With
Next x
Set objMailItem = Nothing
Set objApp = Nothing
End Sub
In der Zelle "O1" sollten jeweils die Werte von 1 bis ... hochgezählt werden. Sprich von 1 bis ... sind in den anderen Zellen dann jeweils die Daten (Mailadresse, Attachement, Subject etc.) der Adressaten hinterlegt. Bei jedem O1-Wert dann ein anderer Adressat. Nur macht er das so nicht :-(Sieht hier vielleicht jemand auf Anhieb einen Fehler?
Vielen lieben Dank und Gruß
Nik