allegare foto tramite macro excel

[erryrox]

Ecco la mia nuova contorta idea:

Vorrei creare un meccanismo che mi permetta di inviare un e-mail in automatico con degli allegati scelti da me.

Gli allegati sono delle foto contenute in una cartella fissa, dove ogni giorno vengono aggiunte nuove foto. Ogni giorno vorrei mandare un e-mail con le foto del giorno stesso.
La mia idea è quella di creare un foglio excel con un elenco di collegamenti ipertrestuali alle foto del giorno e poi su questo foglio excel impostare una macro che invii le e-mail allegando le foto.
Le foto nel loro nome non hanno nessun riferimento alla data, però nelle "proprietà" della foto c'è la data.

Quindi i problemi sono:
- creare una macro che scelga solo le foto del giorno
- allegare queste foto ad un e-mail.

Potete aiutarmi?
Il codice che ho iniziato a scrivere:

Codice: Seleziona tutto

Sub rettangolo1_Click()

Dim OutApp As Object
Dim OutMail As Object
Dim EmailAddr As String
Dim EmailAddrCC As String
Dim Subj As String
Dim BodyText As String

EmailAddr = "XXX"
Subj = "Foto  del " & Range("c2").Value

BodyText = "In allegato del " & Range("c2").Value      '''''C2= DATA ODIERNA"

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

With OutMail
.To = EmailAddr
.CC = EmailAddrCC
.BCC = ""
.Subject = Subj
.Body = BodyText
.Attachments = '''''''''''''' QUI COSA INSERISCO per ALLEGARE LE FOTO????

.Send

End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

[erryrox]

forse meglio fare un passo alla volta, rendendo le cose più semplici....

E' possibile "trasformare" un collegamento ipertestuale presente in una cella excel in un allegato di un e-mail? tramite macro ovviamente...

grazie

[Flash30005]

il secondo post non l'ho capito
Per inviare più allegati in una email occorre un ciclo for next che scansioni il range dove c'è l'elenco dei nomi dei file (in questo caso .jpg)
pertanto supponendo che l'elenco sia nella colonna G e il percorso del file nella colonna F (Percorso che puoi mettere fisso nella macro), ua macro potrebbe essere questa
La macro dopo l'invio degli allegati, sposterà gli allegati in una sottocartella "ArchivioAll"

Codice: Seleziona tutto

Sub Invia_Email_AllegatiJpg()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim EmailAddr As String
    Dim Subj As String
    Dim BodyText As String
    Dim fs, f
    Foglio1.Select
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Quit
    Set OutApp = Nothing
     Application.Wait (Now + TimeValue("0:00:05"))
' RR contiene il numero di utenti cui inviare le e-mail (1 per utente)
    RR = Range("B" & Rows.Count).End(xlUp).Row
' I dati iniziano dalla seconda riga
    For I = 2 To RR
        Perc = Cells(I, 6).Value
        If Dir(Perc & "ArchivioAll", vbDirectory) = "" Then MkDir (Perc & "ArchivioAll")
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set f = fs.getfolder(Perc)
        Set NFile = f.Files
        NomeF = Cells(I, 7).Value
        NomeP = Replace(NomeF, ".Jpg", "")
        LNome = Len(NomeP)

        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
' La colonna "B" contiene gli indirizzi e-mail dei vari destinatari
                  .To = Cells(I, 2)
' La colonna "C" contiene l'indirizzo e-mail in "Copia per Conoscenza"
                  .CC = Cells(I, 3)
' Eventuale e-mail in "Copia per conoscenza nascosta"
                  .BCC = ""
' La colonna "D" contiene l'oggetto della e-mail
                 .Subject = Cells(I, 4)
' La colonna "E" contiene l testo della e-mail
                  .Body = Cells(I, 5)
' La colonna "F" contiene il percorso ove si trova il file da allegare
' La colonna "G" contiene il nome del file da allegare
                    For Each Jpg1 In NFile
                        If Jpg1.Name = "" Then Exit Sub
                        If Mid(Jpg1.Name, 1, LNome) = NomeP And Mid(Jpg1.Name, Len(Jpg1.Name) - 3, 4) = ".Jpg" Then
                .Attachments.Add (Perc & Jpg1.Name)
                        End If
                    Next
                .Send
                MsgBox ("mail inviata")
                Application.Wait (Now + TimeValue("0:00:02"))
               
                For Each Jpg1 In NFile
                    If Jpg1.Name = "" Then Exit Sub
                    If Mid(Jpg1.Name, 1, LNome) = NomeP And Mid(Jpg1.Name, Len(Jpg1.Name) - 3, 4) = ".Jpg" Then
                        Inpfile = Perc & Jpg1.Name
                        outfile = Perc & "ArchivioAll\" & Jpg1.Name
                        Name Inpfile As outfile
                    End If
                Next
        End With
        Set fs = Nothing
        Set f = Nothing
        Set NFile = Nothing
        Set OutMail = Nothing
        Set OutApp = Nothing
        Application.Wait (Now + TimeValue("0:00:03"))
    Next I
MsgBox ("Invio completato")

End Sub

Vedi note all'interno della macro e dattale alla tua esigenza

ciao

[erryrox]

Grazie mille per l'aiuto flash.

Ho provato con il tuo codice, funziona tutto tranne l'inserimento degli allegati. Essendo il tuo codice troppo complesso per me, ho provato a rubare qualche stringa ed inserirla nel mio.

Questo è il risultato (non funzionante - errore nella riga attachment).
Nel mio foglio, la colonna F contiene il percorso completo (percorso + nome file) di tutte le foto da allegare.

Codice: Seleziona tutto

Sub rettangolo1_Click()

Dim OutApp As Object
Dim OutMail As Object
Dim EmailAddr As String
Dim EmailAddrCC As String
Dim Subj As String
Dim BodyText As String

EmailAddr = "xxx"
EmailAddrCC = ""

Subj = "Foto " & Range("C2").Value

BodyText = "In allegato foto del " & Range("c2").Value

RR = Range("F" & Rows.Count).End(xlUp).Row

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

With OutMail
.To = EmailAddr
.CC = EmailAddrCC
.BCC = ""
.Subject = Subj
.Body = BodyText
 
For I = 2 To RR
Perc = Cells(I, 6).Value        ''''' COLONNA DOVE CI SONO I COLLEGAMENTI ALLE FOTO DA ALLEGARE
.Attachments.Add (Perc)     ''''''''''''ERRORE!!!
Next
.Display
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

probabilmente il ciclo che ho impostato per allegare le foto è sbagliato, ma non essendo un programmatore non riesco a capire il problema. grazie

[Flash30005]

Hia inserito anche l'estensione?
potresti inviare uno screenshot dei dati?

Avrei preferito più un percorso fisso e aggiungere il nome del file (da elenco)
anche perché, dopo, avrai problemi ad archiviare i file (toglierli dalla cartella originale e inserirli nella cartella file inviati)

ciao