Buongiorno a tutti,

chiedo il vostro aiuto per integrare una vecchia macro: al momento quella già presente invia un'e-mail per ogni destinatario presente in un file excel allegando due file, contenuti in una specifica cartella, il cui nome è riportato in due celle excel (attachment 1 e 2).

La nuova dovrebbe allegare tutti gli n file, contenuti nella stessa cartella, le cui prime 4 cifre del nome coincidono con quelle scritte in una cella excel (attachment 3).

E' sicuramente fattibile, ma non riesco a svilupparla

Di seguito riporto il codice della vecchia macro, grazie anticipatamente

Lorenzo

Dim myOutlook As Object, myMailItem As Object`
Dim otlApp As Object

Dim olMailItem

Dim otlNewMail

Dim i As Integer, x

Dim cartella As String, allegato As String, allegato2 As String, percorso As String, percorso2 As String

Dim sh1 As Worksheet

 

Application.ScreenUpdating = False

 

cartella = "W:\Scanner CessV\oggi"

Set sh1 = ThisWorkbook.Worksheets("Indirizzi")

sh1.Activate

For i = 2 To [counta(f:f)]

Set otlApp = CreateObject("Outlook.Application")

Set otlNewMail = otlApp.CreateItem(olMailItem)

 

allegato = Cells(i, 6)

allegato2 = Cells(i, 7)

percorso = cartella & "\" & allegato & ".pdf"

percorso2 = cartella & "\" & allegato2 & ".xlsx"

 

Data = Format(Now(), "dd/mm/yyyy")

 

If FileExist(percorso) Then

With otlNewMail

.To = Cells(i, 2)

.CC = Cells(i, 3)

.Subject = Cells(i, 4) & Data

.Body = Cells(i, 5)

.Attachments.Add percorso

 

If FileExist(percorso2) Then

.Attachments.Add percorso2

End If

 

.Display

'.Send

End With

 

End If

 

Next i

 

Set otlApp = Nothing

Set otlNewMail = Nothing

Application.ScreenUpdating = True

 

End Sub

 

Private Function FileExist(file As String) As Boolean

 

If Dir(file) <> "" Then

FileExist = True

Else

FileExist = False

End If

 

End Function