Re : Maco pour récupérer le nom du fichier
Salut PierreJean.
Un seul mot: Trop trop bien.
Juste une petite question: Si l'utilisateur appui sur annulé de la boite de dialogue enregistrer sous, est il possible d'éviter que le ficiehr s'enregistre. (faux.csv)
Vu que je suis tombé sur un pro j'ai une autre petite question:
Cette macro me permet d'envoyé une copie de ma feuill1 par mail mais sans le body à cause de sendmail qui ne le permet pas.
:
Sub Commande()
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
'Dim nb_migration As Integer
Dim nom_fichier As String
nom_fichier = ActiveWorkbook.Name
Set Source = Nothing
On Error Resume Next
Set Source = Range("A1:AN200").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = nom_fichier
FileExtStr = ".csv"
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr
On Error Resume Next
.SendMail Recipients:="azerty@voila.fr", Subject:="fichier deploiement"
On Error GoTo 0
.Close SaveChanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Ceci marche bien mais je voudrais avoir le body pour le message envoyé.
Donc voici ce que j'ai fais:
Les Modifications sont en gras
Sub OBS()
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sujet As String
Dim S As String
S = Feuil1.Range("E2").Value
Set Source = Nothing
On Error Resume Next
Set Source = Range("A1:F200").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = "Planification_migrations_S" & S
Sujet = "Planification définitive des migrations S" & S
FileExtStr = ".xls"
With Dest
SaveAs TempFilePath & TempFileName & FileExtStr
On Error Resume Next
.Close SaveChanges:=False
End With
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr
On Error Resume Next
Dim appOutlook As Outlook.Application
Dim message As Outlook.MailItem
Dim myRecipient As Object
Dim email As String
'Crée une session Microsoft Outlook
Set appOutlook = CreateObject("outlook.application")
'Crée un nouveau message
Set message = appOutlook.CreateItem(olMailItem)
' initialisation de variables
email = "azerty@voial.fr
'Titre, texte, destinataires, etc ... et envoi.
With message
.Subject = Sujet
.body = "Bonjour," & vbCr & vbCr
.Recipients.Add (email)
.attachments.Add TempFilePath & TempFileName & FileExtStr
.Send
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Cela fonctionne aussi (code que j'ai repris 😉 )
Le p'tit pb c'est que ici cela me créer un fichier qui s'affiche ac la copie de la feuille 1.
Moi je voudrais juste que cela envoi la copie de la feuill 1 par mail.
(Que cela soit transparent pour l'utilisateur)
Merci bcp