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
7.xlsm (62.73 Ko)

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

Rechercher des sujets similaires à "fonction kill file qui fonctionne pas"