CÉÉ UNE NOUVELLE EXTENTION ET LANCER SON PROG AVEC

Private Sub CréationAssociation(CheminEXE As String, CheminIcône As String, Filetype As String, Extention As String, Nomduprog As String)
    Dim r
Set r = CreateObject("WScript.Shell")
r.RegWrite "HKEY_CLASSES_ROOT\" & Extention & "\", Filetype
r.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\" & Extention & "\OpenWithList\a", CheminEXE
r.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\" & Extention & "\OpenWithList\MRUList", "a"
r.RegWrite "HKEY_CURRENT_USER\Software\" & Nomduprog & "\ClefHandle", CheminEXE
r.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Classes\" & Extention & "\", Filetype
r.RegWrite "HKEY_USERS\S-1-5-21-2000478354-839522115-1202660629-1000\Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\" & Extention & "\OpenWithList\a", Nomduprog & ".exe"
r.RegWrite "HKEY_USERS\S-1-5-21-2000478354-839522115-1202660629-1000\Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\" & Extention & "\OpenWithList\MRUList", "a"
r.RegWrite "HKEY_USERS\S-1-5-21-2000478354-839522115-1202660629-1000\Software\" & Nomduprog & "\ClefHandle", CheminEXE
r.RegWrite "HKEY_CLASSES_ROOT\Applications\" & Nomduprog & ".exe\shell\open\command\", CheminEXE & " ""%1"""
r.RegWrite "HKEY_CLASSES_ROOT\" & Filetype & "\DefaultIcon\", CheminIcône
r.RegWrite "HKEY_CLASSES_ROOT\" & Filetype & "\shell\open\command\", CheminEXE & " ""%1"""
End Sub

Private Sub Command1_Click()
CréationAssociation App.Path & "\Exemple.exe", App.Path & "\supra.ico", "SupraTxt", ".supra", "Exemple"
Label1.Caption = "Cliquer sur test.supra pour essayer"
End Sub