[Tasos]

Αγαπητέ Λάκη καλημέρα.

Ο παρακάτω κώδικας αποθηκεύει το επιθυμητό φύλλο Excel σε νέο βιβλίο και το στέλνει στο
Outlook σαν συνημμένο προσθέτοντας τους παραλήπτες που βρίσκονται σε ορισμένη περιοχή του
βιβλίου (MailAddresses).

Αφού λοιπόν ορίσεις την περιοχή "MailAddresses" στο βιβλίο εργασίας σου που θα περιέχει τους παραλήπτες, πέρασε τον παρακάτω κώδικα σε μια λειτουργική μονάδα, κάνε τις απαραίτητες προσαρμογές (όνομα φύλλου, θέμα, Όνομα του νέου αρχείου, ενδεχομένως κείμενο στο κυρίως σώμα του Μηνύματος) και κάνε τις δοκιμές σου.

Ο κώδικας αυτός λειτουργεί και στο Office 2003 και στο Office 2007 σε περιβάλλον Exchange.
Αν δεν υπάρχει Exchange Server, τότε τα πράγματα διαφοροποιούνται και θα χρειαστεί διαφορετικός
χειρισμός.

Φιλικά

Τάσος

Option Explicit



Sub Send_Excel_Sheet_via_Outlook()

    Dim msg As Object, oApp As Object, _

    wbFullName$, strRecipients$, i%, SheetName$

    

    SheetName = Sheets(1).Name

    wbFullName = Environ("temp") & "\" & SheetName & _

    Replace(Format(Now, "_dd_mm_yy_hh:mm:ss") & ".xls", ":", "_")

    

    With Range("MailAddresses")

    For i = 1 To .Count

            If .Item(i) <> vbNullString Then _

            strRecipients = strRecipients & .Item(i) & ";"

        Next

    End With

    

    Sheets(1).Copy

    

    With ActiveWorkbook

        .SaveAs Filename:=wbFullName

        .Close

    End With



    Set oApp = CreateObject("Outlook.Application")

    Set msg = oApp.CreateItem(0)

    

    With msg

        .To = strRecipients

        .Subject = SheetName & " " & Date & " " & Time ' Προσάρμοσε το κείμενο του θέματος στα μέτρα σου.

        .Attachments.Add wbFullName

        .Body = "This is a Test." & vbLf & "Please ignore." ' Προσάρμοσε το κείμενο στα μέτρα σου.

        .Display ' εμφανίζει το μήνυμα

        '.Send ' αποθηκεύει το μήνυμα στο φάκελο  του Outlook "OutBox"

    End With

    

    Set oApp = Nothing

    Set msg = Nothing

End Sub