Fonction Do ne fonctionne pas

Bonjour,

Ma fonctionne Do ne fonctionne pas, il doit avoir un problème sur mon code mais je n'arrive pas à résoudre la chose...

une aide charitable ?

Sub testEmail()
Dim olApp As Outlook.Application
Set olApp = CreateObject("outlook.application")
Dim wb As Workbook
Dim filename As String
Dim olMail As Outlook.MailItem
Dim i As Integer: i = 1
Set wb = ActiveWorkbook
With wb

   Do

    filename = .Path & "\" & .Sheets(1).Name & ".pdf"
    .Sheets(1).ExportAsFixedFormat xlTypePDF, filename, , , False
    With .Sheets(Sheets("BDD") & Range("G" & i).Copy)

            With olApp.CreateItem(olMailItem)
                .To = wb.Sheets("BDD").Range("H" & i).Value '.Recipients.Add Sheets("BDD").Range("H" & i).Value
                .CC = wb.Sheets("BDD").Range("I" & i).Value
                .Subject = "SITUATION des SILLONS"
                .Body = MyBody
                .Attachments.Add filename
                .Display
                '.Send
            End With
        i = i + 1

   Loop While filename = .Path & "\" & .Sheets(1).Name & ".pdf"
    .Sheets(1).ExportAsFixedFormat xlTypePDF, filename, , , False

    End With
End With
Kill filename
End Sub

Function MyBody()
temp = "Bonjour," & vbLf & vbLf
temp = temp & "Vous trouverez ci joint les sillons obtenus et les commandes en cours." & vbLf & vbLf
temp = temp & "Cordialement" & vbLf & vbLf & vbLf
temp = temp & "Adrien LOBEL"
MyBody = temp
End Function

merci

Bonjour,

LOOP est placé avant END WITH (le 2ème) donc ça ne va pas.

Cdlt

super merci pour ton aide