Fonction kill file qui ne fonctionne pas
bonjour
J'ai un code qui sauvegarde un onget excel la on choisit, puis transforme cet onglet en PDF et génère un email avec en pièce jointe le fichier PDF.
Tout fonctionne sauf le kill PDF file... Ca bug.
Le fichier excel est sauvegardé sur le desktop alors qu'il ne le devrait pas.
Vous savez pourquoi ?
Voici le code complet- je joins le fichier- il n'est pas en lettres latines mais j'ai changé en anglais seulement ce qui est important pour la compréhension .
Sub presend()
Dim ret As Integer
ret = MsgBox("Do you want to save and send this document to the accounting department?", vbYesNo)
If ret = vbNo Then
MsgBox "It has not been sent", vbInformation
Exit Sub
Else
Call save_excel
End If
End Sub
Sub sendemail()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object
' title for email subject
Title = Range("C3") & " " & Range("b5") & " " & "-" & " " & Range("F4")
' Define PDF filename
PdfFile = ActiveWorkbook.FullName & " " & Range("b4")
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & ".pdf"
' Export activesheet as PDF
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)
' Prepare e-mail
.Subject = Title
.To = "my email " ' <-- Put email of the recipient here
.CC = " " ' <-- Put email of 'copy to' recipient here
.Body = " Hey " & vbLf & vbLf _
& " Please find in attachment the details for preparing salary. " & vbLf & vbLf _
& " " & vbLf & vbLf _
& "Bset regards" & vbLf _
& Application.UserName & vbLf & vbLf
.Attachments.Add PdfFile
' Try to send
On Error Resume Next
'.send
.display
Application.Visible = True
If Err Then
MsgBox "?????? ?? ?????", vbExclamation
Else
End If
On Error GoTo 0
End With
' Delete PDF file
Kill PdfFile
' Quit Outlook if it was created by this code
If IsCreated Then OutlApp.Quit
' Release the memory of object variable
Set OutlApp = Nothing
End Sub
Sub save_excel() ' save a copy as excel
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim ret As Integer
Dim destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim S As Shape
Dim sNomFic As String, sRep As String, WshShell As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' Cr?er une instance Windows Script pour retrouver le chemin du bureau
Set WshShell = CreateObject("WScript.Shell")
sRep = WshShell.SpecialFolders("Desktop")
Set WshShell = Nothing
' D?finit le nom du fichier ? enregistrer
sNomFic = Range("C3") & " " & Range("b5") & " " & "-" & " " & Range("F4") & ".xls"
' Enregistrer la feuille sous excel
wk1 = ThisWorkbook.FullName 'pour enregistrer via fenetre save as
With Application.FileDialog(msoFileDialogSaveAs)
.FilterIndex = 4
.InitialFileName = sRep & "\" & sNomFic
.AllowMultiSelect = False
.Title = "Select a folder then hit OK"
If .Show = -1 Then
ActiveWorkbook.SaveAs Filename:=.SelectedItems(1)
ActiveWorkbook.Saved = True
Else
Exit Sub
End If
End With
Call sendemail
Application.Quit
End Sub
Bonjour,
Pourquoi fais-tu ton Application.Quit si tôt ?
Sendmail n'a peut-être pas le temps de finir.
eric
Bonjour ericw, eriiic
Le fichier excel est sauvegardé sur le desktop alors qu'il ne le devrait pas.
Heu ... a priori si ...
Dans la Sub save_excel() :
[code]' Cr?er une instance Windows Script pour retrouver le chemin du bureau
Set WshShell = CreateObject("WScript.Shell")
sRep = WshShell.SpecialFolders("Desktop") ' <= initialisation du répertoire de sauvegarde : Bureau
Set WshShell = Nothing
' D?finit le nom du fichier ? enregistrer
sNomFic = Range("C3") & " " & Range("b5") & " " & "-" & " " & Range("F4") & ".xls"
' Enregistrer la feuille sous excel
.../...
pardon, mal précisé
le fichier excel est sauvegardé là on on décide de le sauvegarder. ça c'est bon.
Mais à la fin de l'opération, on ne doit pas passer au nouveau fichier excel, mais on doit rester avec le fichier d'origine...
réponse à Eriiic:
"application quit" est à la fin de la sub "sendemail'
Pour enregistrer sous et rester sur le classeur origine, utiliser SaveCopyAs au lieu de SaveAs
Merci AlgoPlus!
Maintenant, effectivement je reste sur le classeur d'origine.
Mais l'autre problème subsiste, à savoir:
le fichier PDF qui est créé automatiquement dans la procédure d'envoi d'email, devrait être ensuite effacé de l'ordinateur grâce à Kill PDFFile mais ça ne marche pas- il y a un bug et le fichier PDF reste sur le Desktop