XL 2019 chemin universel pour supprimer un fichier sur le bureau de n'importe quel PC

[pat66]

Bonjour Le forum,

pourriez vous m'aider en m'indiquant comment écrire le chemin universel pour supprimer un fichier qui se trouve sur le bureau quelque soit l'username du PC
j'arrive à supprimer le fichier sil est dans le même dossier avec ThisWorkbook.Path, L'idéal étant de supprimer le fichier en vérifiant le disque dur (C
Sub supprime()
Dim strUser As String, strPath As String
On Error Resume Next
strUser = Environ("username")
strPath = "c:\users\" & strUser & "\ desktop \"
Workbooks("test1.xlsm").Close False 'ferme le fichier s'il est ouvert
Kill ThisWorkbook.Path & "\test1.xlsm"
Kill "C:\Users\strUser\strPath\test1.xlsm"
End Sub

merci

 

[sylvanu]

Bonjour Pat,
Testé mais pas sur un seul PC :

Sub supprime()
    Dim Fichier$
    Fichier = Environ("USERPROFILE") & "\desktop\Test1.xlsm"
    On Error Resume Next
    Workbooks("test1.xlsm").Close False
    If Len(Dir(Fichier)) > 0 Then Kill Fichier
End Sub

 

[Bernard_XLD]

Bonjour Pat66, Sylvanu, le forum

une autre façon.

Bien cordialement

Sub Supprime_Fichier_sur_Bureau()
    Dim Objet_Shell, Objet_FileSystem, Objet_Fichier, Nom_Fichier$
    
    Nom_Fichier = "Toto.Xlsx"
    
    On Error Resume Next 'en cas d'erreur, saut à la ligne suivante
    Set Objet_Shell = CreateObject("WScript.Shell") 'on cree un object wscriptshell
    Nom_Fichier = Objet_Shell.SpecialFolders("Desktop") & "\" & Nom_Fichier 'on détermine le fullname d'une copie éventuelle sur le bureau
    If Len(Dir(Nom_Fichier)) > 0 Then 'on teste l'existence d'une copie éventuelle sur le bureau
        Set Objet_FileSystem = CreateObject("Scripting.FileSystemObject") 'on définit l'objet filesystem
        Set Objet_Fichier = Objet_FileSystem.GetFile(Nom_Fichier) 'on définit l'objet fichier
        Objet_Fichier.Delete 'on supprime la copie locale
    End If
End Sub

 

[pat66]

Bonjour

un grand merci à tous les deux, pour l'instant je vais utiliser celle de Sylvanu, mais je garde précieusement celle de Yeahou qui fonctionne aussi très bien

cdt