Moderatori: Anthony47, Flash30005
Sub SendF1F2()
Dim shTSend, I As Long, fTAttach As String
Dim oApp As Object, oMail As Object, mDest As String
'
shTSend = Array("Sheet2", "Foglio1") '<<< I Fogli da inviare come allegato, anche piu' di 2
fTAttach = "Allegato_" '<<< Il nome per il file da inviare
mDest = "account@Dominio.ZZ" '<<< destinatario email
'
'Crea file da allegare:
Sheets(shTSend(1)).Copy
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
ActiveSheet.Name = ThisWorkbook.Sheets(shTSend(I)).Name
For I = 1 To UBound(shTSend)
ThisWorkbook.Sheets(shTSend(I)).Copy After:=Workbooks(Workbooks.Count).Sheets(1)
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
ActiveSheet.Name = ThisWorkbook.Sheets(shTSend(I)).Name
Next I
fTAttach = ThisWorkbook.Path & "\" & fTAttach & Format(Now, "yyyy-mm-dd_hh-mm-ss") & ".xlsx"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=fTAttach
Application.DisplayAlerts = True
ActiveWorkbook.Close False
'Crea email e invia
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
oMail.To = mDest
oMail.Subject = "Invio non so che cosa"
oMail.Body = "Buongiorno" & vbCrLf & "In allegato il documento di vostra competenza"
oMail.Attachments.Add fTAttach
oMail.Display
' oMail.Send
Application.Wait (Now + TimeValue("0:00:02"))
Set oMail = Nothing
Set oApp = Nothing
End Sub
Sub SendF1F2Pdf()
Dim shTSend, I As Long, fTAttach As String
Dim oApp As Object, oMail As Object, mDest As String
Dim aNames(), pdfName As String, cNaame As String
'
shTSend = Array("Sheet2", "Foglio1", "Foglio3") '<<< I Fogli da inviare come allegato
fTAttach = "Allegato_" '<<< Il nome per il file da inviare
mDest = "email@dominio.zz" '<<< destinatario email
'
'Crea file da allegare:
ReDim aNames(0 To UBound(shTSend))
pdfName = ThisWorkbook.Path & "\" & fTAttach & Format(Now, "yyyy-mm-dd_hh-mm-ss") & "_##.pdf"
For I = 0 To UBound(shTSend)
aNames(I) = Replace(pdfName, "##", Chr(65 + I), , , vbTextCompare)
ThisWorkbook.Sheets(shTSend(I)).ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=aNames(I), OpenAfterPublish:=False
Next I
'
'Crea email e invia
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
oMail.To = mDest
oMail.Subject = "Invio non so che cosa"
oMail.Body = "Buongiorno" & vbCrLf & "In allegato il documento di vostra competenza"
For I = 0 To UBound(aNames)
oMail.Attachments.Add aNames(I)
Next I
oMail.Display
' oMail.Send
Application.Wait (Now + TimeValue("0:00:02"))
Set oMail = Nothing
Set oApp = Nothing
End Sub
fTAttach = "@@@@_" '<<< Il nome per il file da inviare
aNames(I) = Replace(Replace(pdfName, "##", Chr(65 + I), , , vbTextCompare), "@@@@", shTSend(I), , , vbTextCompare)
Torna a Applicazioni Office Windows
confrontare e evidenziare 2 fogli excel Autore: niccia |
Forum: Applicazioni Office Windows Risposte: 7 |
Creare/ripristinare un “Immagine di sistema” - Win 10/11 Autore: m.paolo |
Forum: Sistemi Operativi Windows Risposte: 0 |
Visitano il forum: Nessuno e 8 ospiti