Loop voor Excel om bestanden te versturen

[nikos84]

Beste,

Ik ben al een heel eind gekomen met het schrijven van een VBA, maar nu wil ik eigenlijk dat wanneer de code ten einde hij opnieuw begint tot mijn range is afgelopen (max regel 177).

Code tot dusver:
Sub EmailViaOutlook()
'Create the email object

Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.to = Sheets(1).Range("G93")
.CC = Sheets(1).Range("H93")
.BCC = Sheets(1).Range("I93")
.Subject = "Costcenter report(s) 2016-06"
.Body = "TEXT"

.Attachments.Add Sheets(1).Range("J93").Value & ".xlsx"
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Het betreft dus 177 emails met verschillende files en verschillende adressen.
Kunnen jullie hiermee helpen?

 

[edmoor]

Probeer dit eens:

Sub EmailViaOutlook()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim r As Long
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    On Error Resume Next
    For r = 1 To 177
        With OutMail
            .to = Sheets(1).Range("G" & r)
            .CC = Sheets(1).Range("H" & r)
            .BCC = Sheets(1).Range("I" & r)
            .Subject = "Costcenter report(s) 2016-06"
            .Body = "TEXT"
            
            .Attachments.Add Sheets(1).Range("J" & r).Value & ".xlsx"
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Send
        End With
    Next r
    On Error GoTo 0
    
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

[nikos84]

Hij verstuurd netjes de eerste mail, maar daarna niks meer. Ook geen foutmelding bijv.

gr

 

[edmoor]

Dan moet je die On Error Resume Next eens uitschakelen.
Dan zie je wat er mis gaat.

 

[nikos84]

Ik krijg een error bij de code" .To = Sheets(1).Range("G" & r)" het item is verplaatst of verwijderd.

 

[edmoor]

Plaats je document eens.

Tevens zie ik net dat er een fout in zit.
Deze regel:
Set OutMail = OutApp.CreateItem(0)
moet binnen de loop worden geplaatst.

 

[nikos84]

Bij deze.

 

[nikos84]

Door die laatste opmerking van je te gebruiken loopt de macro nu als een zonnetje!
Hartelijk dank!!!