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