Mail attachement xlsm to xlsx

Bonjour,
Je voudrais envoyer la deuxième page de mon classeur. xlsm par Outlook.
J'aimerais l'envoyer au format .xlsx sans les macros.

J'ai le code ci-dessous qui envoie tout le classeur au format xlsm que je voudrais adapter à mon utilisation.
Pouvez-vous svp, m'aider ? Merci !

Private Sub CommandButton1_Click()

    ActiveWorkbook.Save

    Dim xOutApp As Object

    Dim xMailItem As Object

    Dim xName As String

    On Error Resume Next

    Set xOutApp = CreateObject("Outlook.Application")

    Set xMailItem = xOutApp.CreateItem(0)

    xName = ActiveWorkbook.FullName

    With xMailItem

        .To = "tets@test.com"

        .CC = "test2@test.com"

        .Subject = "liste" & Chr(32) & Date

        .Body = "mon message "

        .Attachments.Add xName

        .Display

       '.send

    End With

    Set xMailItem = Nothing

    Set xOutApp = Nothing

End Sub

 

Bonsoir

ci joint un code que j'utilise pour envoyer la feuille active par mail... a adapter en conséquence

Sub mail()
'Fonctionne sous excel 2000-2013
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object

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

Set Sourcewb = ActiveWorkbook

    'Copie la feuille active comme nouvelle feuille
ActiveSheet.Copy ' adapter si c'est pas la feuille active
Set destwb = ActiveWorkbook

FileExtStr = ".xlsx": FileFormatNum = 51

'Désactiver fenêtre de compatibilité
        Application.DisplayAlerts = False

    'Sauvegarde la nouvelle feuille/L'envoie par mail/La supprime
TempFilePath = Environ$("temp") & "\"
TempFileName = ActiveSheet.Name

Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)

With destwb
    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
    On Error Resume Next
    With OutMail
        .To = "test@test.com"
        .CC = "test2@test.com"
        .bcc = ""
        .Subject = "liste" & Chr(32) & Date
        .Attachments.Add destwb.FullName
        .Body = "Bonjour "
        .display 'ou alors utiliser .Send
    End With
    On Error GoTo 0
    .Close savechanges:=False
End With

    'Effacer le fichier envoyé
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

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

End Sub

Bonjour,

Une proposition.

Cdlt.

Bonjour Fred2406 : même source !

Public Sub Mail_ActiveSheet()
'https://www.rondebruin.nl/index.htm
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object

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

    Set Sourcewb = ActiveWorkbook
    Sourcewb.Worksheets("A définir").Copy
    Set Destwb = ActiveWorkbook
    TempFilePath = Environ$("temp") & "\"
    TempFileName = Sourcewb.Name & " " & Format(VBA.Date, "yyyy-mm-dd")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With Destwb
        .SaveAs TempFilePath & TempFileName & ".xlsx", FileFormat:=51
        On Error Resume Next
        With OutMail
            .to = "tets@test.com"
            .CC = "test2@test.com"
            .Subject = "liste" & Chr(32) & Format(VBA.Date, "yyyy-mm-dd")
            .Body = "mon message "
            .Attachments.Add Destwb.FullName
            .display '(pas de majuscule ?)
            '.send
        End With
        On Error GoTo 0
        .Close savechanges:=False
    End With
    Kill TempFilePath & TempFileName & ".xlsx"

    Set OutMail = Nothing
    Set OutApp = Nothing

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

End Sub

Bonsoir Jean-Eric..

Possible cest un code que j'ai en stock car c'est une demande régulière.... mais je ne sais plus d'où il venait...

Maintenant oui ... grâce à toi rondebruin......

A+

Fred

Bonjour à vous,

Vous êtes super! Merci beaucoup.

- Comment je pourrais enlever le format de fichier d'origine qui est dans le nouveau fichier prêt pour l'envoie ?Exemple Liste.xlsm27.10.2020.xlsx

Edit: Trouvé :) Enlever le "Sourcewb.Name &"

dans

Bonjour... dans ce cas..

fred

Bonjour,