Stellar Blade Un'esclusiva PS5 che sta facendo discutere per l'eccessiva bellezza della protagonista. Vieni a parlarne su Award & Oscar!

Excel Forum Per condividere esperienze su Microsoft Excel

VBA - invio file excel via email

  • Messaggi
  • OFFLINE
    stellablu79
    Post: 32
    Registrato il: 29/06/2008
    Città: ACQUAFONDATA
    Età: 44
    Utente Junior
    excel 2007
    00 02/10/2019 16:46
    ciao a Tutti
    ho un file con una macro che mi invia ogni sheet di un file excel ad un indirizzo email in cella A1
    questa la macro:

    Sub Mail_Every_Worksheet()
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object

    TempFilePath = Environ$("temp") & "\"

    If Val(Application.Version) < 12 Then
    'You use Excel 97-2003
    FileExtStr = ".xls": FileFormatNum = -4143
    Else
    'You use Excel 2007-2016
    FileExtStr = ".xlsm": FileFormatNum = 52
    End If

    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    End With

    Set OutApp = CreateObject("Outlook.Application")

    For Each sh In ThisWorkbook.Worksheets
    If sh.Range("A1").Value Like "?*@?*.?*" Then

    sh.Copy
    Set wb = ActiveWorkbook

    TempFileName = "Sheet " & sh.Name & " of " _
    & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    Set OutMail = OutApp.CreateItem(0)

    With wb
    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

    On Error Resume Next
    With OutMail
    .to = sh.Range("A1").Value
    .CC = ""
    .BCC = ""
    .Subject = "This is the Subject line"
    .Body = "Hi there"
    .Attachments.Add wb.FullName
    'You can add other files also like this
    '.Attachments.Add ("C:\test.txt")
    .Send 'or use .Display
    End With
    On Error GoTo 0

    .Close savechanges:=False
    End With

    Set OutMail = Nothing

    Kill TempFilePath & TempFileName & FileExtStr

    End If
    Next sh

    Set OutApp = Nothing

    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    End With
    End Sub

    ora il mio problema è inviare tutto il file excel se presente qeusto indirizzo email in A1
    vi spiego meglio: il mio file ha due foglio sheet1 e sheet2, quindi metto email in A1 di sheet2 e il foglio va' automaticamente via email; ma se io invece volessi mandare anche sheet1 sempre alla stessa email? mettendo l'email anche in A1 di sheet1 la macro funziona ma genera 2 EMAIL differenti (sempre allo stesso indirizzo in A1)

    qualcuno riesce ad aiutarmi ?
    grazie come sempre
    Paola
  • OFFLINE
    stellablu79
    Post: 32
    Registrato il: 29/06/2008
    Città: ACQUAFONDATA
    Età: 44
    Utente Junior
    excel 2007
    00 10/10/2019 10:01
    nessuno ? :-(
    grazie