Macro che allega un file ad una mail

[tav]

Ciao a tutti,

vorrei allegare, tramite pulsante, un foglio di un file excel ad una mail che come oggetto prenda il nome del file salvato.

il file viene recuperato dal seguente percorso (\\193.43.114.144\shares\Divisione Buitoni\Supply Chain\Demand&Supply Planning\Business Position & Supply Issues Monitor BUITONI\SUPPLY ISSUES MONITOR\prova Andrea\storico chilled SIM/ ) e il suo nome è sempre SIM 16-04-2018 ( la data cambia ogni giorno, quindi ogni giorno mi deve prendere il più aggiornato)

inoltre mi piacerebbe che nel campo a: e cc: vengano inseriti i nomi delle persone che sono presenti in un elenco ( foglio elenco)


Grazie
Andrea

[tav]

ps non vorrei però l'invio automatico, ma sono io a doverlo dare

[Anthony47]

La tua macro avra' un contenuto simile a questa:

Codice: Seleziona tutto

Sub Invioemail_FoglioAllegato()
Dim OutApp As Object, OutMail As Object
Dim EmailAddr As String, Subj As String
Dim myPath As String, myFN As String
'
myPath = "\\193.43.114.144\shares\Divisione Buitoni\Supply Chain\Demand&Supply Planning\Business Position & Supply Issues Monitor BUITONI\SUPPLY ISSUES MONITOR\prova Andrea\storico chilled SIM\"
myFN = "SIM" & Format(Now, "dd-mm-yyyy") & ".xlsx"  '??? L'estensione l'ho inventata
'Apro il file giornaliero:
Application.EnableEvents = False
Workbooks.Open myPath & myFN, 0
'Salvo il FOGLIO da inviare:
Sheets("Foglio1").Copy              '??? Il nome del foglio da inviare me lo sono inventato
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Environ("Temp") & "\FileAllegato.xlsx"  '??? Anche qui l'estensione l'ho inventata
'Chiudo il file da allegare
ActiveWorkbook.Close False
'Chiudo il file giornaliero:
Workbooks(myFN).Close False
Application.DisplayAlerts = True
'DA QUI SI CREA LA MAIL:
Set OutApp = CreateObject("Outlook.Application")
EmailAddr = "TuaEmail@Dominiozczc.Com"              '<<< INDIRIZZO EMAIL
Subj = "Un Soggetto a piacere"                      '<<< OGGETTO DELLA MAIL
Set OutMail = OutApp.CreateItem(0)
With OutMail
    .body = "Caro amico ti scrivo" & vbCrLf & "Cordiali saluti"      '<<< Un piccolo teesto?
    .to = EmailAddr
    .CC = "altro@altro.cc"                          '<<<
    .BCC = "unaltr@unaltro.cz"                      '<<<
    .Subject = Subj
    .Attachments.Add Environ("Temp") & "\FileAllegato.xlsx" ''??? Sempre estensione inventata
    .display 'or use .send
End With
'  (c)
Set OutMail = Nothing
'  (d)
Set OutApp = Nothing
'
End Sub

Come vedi la macro apre il file "giornaliero", ne copia UN FOGLIO e lo salva come file da allegare; poi crea una mail in Outlook con l'allegato e gli indirizzi che hai predisposto.

Ci sono pero' numerose istruzioni marcate ???, in cui devi inserire informazioni non in mio possesso.
Quelle marcate <<< le devi specializzare per fare cose di cui non conosco i dettagli.

Prova e fai sapere...

[tav]

Ciao Anthony,

mi da un errore su Workbook.open mypath .... e mi dice che non esiste il file ( il file esiste)

ho cambiato già l'estensione dei file che era xlsm.


Altra richiesta nella creazione della mail nel campo to riesco a farlo pescare da un foglio (all'interno dello stesso file) che si chiama elenco ( i nomi in aa si trovano in colonna A) mentre i CC nella colonna B

[tav]

Codice: Seleziona tutto

Sub Invioemail_FoglioAllegato()
    Dim OutApp As Object, OutMail As Object
Dim EmailAddr As String, Subj As String
Dim myPath As String, myFN1 As String, myFN As String
'
myPath = "\\193.43.114.144\shares\Divisione Buitoni\Supply Chain\Demand&Supply Planning\Business Position & Supply Issues Monitor BUITONI\SUPPLY ISSUES MONITOR\prova Andrea\storico chilled SIM\ "
myFN1 = "SIM"
myFN = myFN1 & " " & Format(Now, "dd-mm-yyyy") & ".xlsm"
'Apro il file giornaliero:
Application.EnableEvents = False
Workbooks.Open myPath & myFN, 1
'Salvo il FOGLIO da inviare:
Sheets("INVIO").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Environ("Temp") & "\FileAllegato.xlsm"
'Chiudo il file da allegare
ActiveWorkbook.Close False
'Chiudo il file giornaliero:
Workbooks(myFN).Close False
Application.DisplayAlerts = True
'DA QUI SI CREA LA MAIL:
Set OutApp = CreateObject("Outlook.Application")
EmailAddr = "tav@dominio.com"              '<<< INDIRIZZO EMAIL
Subj = "Mio SIM"                      '<<< OGGETTO DELLA MAIL
Set OutMail = OutApp.CreateItem(0)
With OutMail
    .body = "Buongiorno a tutti," & vbCrLf & "di seguito il Supply Issue Monitor di oggi." vbCrLf "A disposizioni per chiarimenti"
    .to = EmailAddr
    '.CC = "altro@altro.cc"                          '<<<
    '.BCC = "unaltr@unaltro.cz"                      '<<<
    .Subject = Subj
    .Attachments.Add Environ("Temp") & "\FileAllegato.xlsm"
    .display 'or use .send
End With
'  (c)
Set OutMail = Nothing
'  (d)
Set OutApp = Nothing
'
End Sub

[tav]

Ho sistemato il primo punto.
Ora mi da un errore qui:
ActiveWorkbook.SaveAs Environ("Temp") & "\FileAllegato.xlsm"

mi spieghi la funzione?

[Anthony47]

E quale e' l'errore?
E, tanto per portarsi avanti immaginando la risposta, il file che vai a salvare ha delle macro?

Ciao

[tav]

Ciao
Ho risolto il tutto.
Mi sono fermato allo step del campo aa della mail. Avrei bisogno che mi peschi da un foglio chiamato elenco le mail presenti nella colonna A

[tav]

Ciao Anthony,

mi puoi aiutare a risolvere il mio dilemma.

Come faccio a inserire nel campo aa della mail un elenco di email che sono presenti in un foglio chiamato "ELENCO" ?

[Anthony47]

Sarebbe utile che allegassi il codice che hai assemblato.
In linea di massima accedi ai dati delle celle con la sintassi

Codice: Seleziona tutto

Range("IndirizzoCella").Value

; es

Codice: Seleziona tutto

EmailAddr = Range("G8").Value


Informazioni piu' precise conoscendo il layout dei tuoi dati.

Ciao

[scanacc]

Ciao tav, qui dovresti trovare alcuni spunti http://www.pc-facile.com/forum/viewtopic.php?f=26&t=107220

[tav]

https://we.tl/YTwwaPcMKY


Il pulsante si trova nel file sim ( invio mail)

[Anthony47]

Quindi, per chi ci legge, la risposta alla domanda "il file che vai a salvare ha delle macro?" era "No, quindi ho modificato il nome file in .xlsx"

Vedo che vuoi inviare l'email a una ventina di destinatari, piu' un'altra ventina in Copia.
Allora aggiungiamo in coda all'attuale codice un pezzo dedicato a complilare le stringhe dei destinatari in base ai lunghi elenchi presenti su foglio ELENCO:

Codice: Seleziona tutto

Function All_Adr(ByRef CollAdd As Range) As String
Dim oCell As Range, eAdr
'
For Each oCell In CollAdd
    If oCell <> "" Then
        eAdr = eAdr & "; " & oCell
    Else
        Exit For
    End If
Next oCell
All_Adr = Mid(eAdr, 3)
End Function

Poi modifichiamo la parte della macro che crea l'email:

Codice: Seleziona tutto

'Creazione mail:
Set OutApp = CreateObject("Outlook.Application")
''EmailAddr = "tav@dominio.com"              '<<< INDIRIZZO EMAIL
Subj = "SIM Buitoni"                      '<<< OGGETTO DELLA MAIL
Set OutMail = OutApp.CreateItem(0)
With OutMail
    .body = "Buongiorno a tutti," & Chr(10) & _
    Chr(10) & "di seguito il Supply Issue Monitor di oggi."
   
''    Sheets("Elenco").Select
''    EmailAddr = Range("A1:A999").Value
''    CopyCC = Range("B1;B99").Value
    .to = All_Adr(Sheets("Elenco").Range("A1:A200"))
    .CC = All_Adr(Sheets("Elenco").Range("B1:B200"))                       
   
    .Subject = Subj
    .Attachments.Add Environ("Temp") & "\FileAllegato.xlsx"
    .display 'or use .send
End With


Le istruzioni che cominciano con "doppio apostrofo" sono logicamente eliminate (possono essere eliminate anche fisicamente, le ho lasciate per consentirti di capire le modifiche apportate).

Ciao

[tav]

scusa non ho capito dove devo incollare il primo codice

[Anthony47]

In effetti sono stato poco chiaro: il nuovo codice (Function All_Adr) lo accodi al precedente, trattandosi di una funzione aggiuntiva. Poi modifichi la parte centrale (la parte della macro che crea l'email) nella Sub Invioemail_FoglioAllegato

Ciao

[tav]

grazie mille