Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Candidat au Club
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    juin 2012
    Messages
    7
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Technicien maintenance

    Informations forums :
    Inscription : juin 2012
    Messages : 7
    Points : 4
    Points
    4
    Par défaut Script vbs permettant de créer un fichier txt automatiquement sur click bouton droit autre fichier (jpg, etc)
    Bonjour,
    Help!
    Il y a quelques années j'utilisais un script vbs co-rédigé par le gestionnaire du site http://julotsoft.free.fr.
    Voici son principe :
    ' Script permettant avec un clic-droit
    ' sur un fichier ou un dossier quelconque dans l'explorateur Windows,
    ' de créer automatiquement un fichier texte de même mon.
    ' ex: toto.jpg -> toto.txt

    http://julotsoft.free.fr/spip.php?article20

    Sur Win10, jusqu'à la version 1809 pas de souci. Mais depuis la version 1903... Dans le menu contextuel de l'explorateur, je ne retrouve plus le raccourci qui permettait ce "tour de magie" - permettant de créer un fichier txt portant le même nom que celui-ci sur lequel on se trouve.

    J'ai le script initial.
    Est-ce quelqu'un a une idée, pourrait revoir ce code ou donner un truc pour que cela refonctionne? Cela serait top!
    Je n'y connais pas grand chose en programmation. (Ce n'est pas mes quelques notions de php qui m'aideront ici )

    Un grand merci d'avance à la bonne âme qui pourra m'aider!!!

    Bonne journée!

  2. #2
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    juillet 2009
    Messages
    2 273
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : juillet 2009
    Messages : 2 273
    Points : 5 385
    Points
    5 385
    Par défaut
    Salut et BIENVENU sur DVP

    Puisque tu disposes du script d'origine, il serait d'un grand secours qu'on le voit pour essayer de t'aider.
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA) et Ne jamais typer variables et/ou fonctions en VBS.
    Vous pouvez consulter mes contributions
    Ne pas oublier de consulter les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  3. #3
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    juillet 2009
    Messages
    2 273
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : juillet 2009
    Messages : 2 273
    Points : 5 385
    Points
    5 385
    Par défaut
    Sans voir ton code, j'ai pu en créer un qui fait le boulot souhaité.

    Une première exécution sans arguments est nécessaire pour faire apparaitre le menu contextuel voulu.
    Le script peut être placé n'importe où et il saura mettre à jour son chemin dans la base du registre.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    Option Explicit 
     
    Dim fso, Fich, oArgs, strPath, NewFile, bReplace, OpenExisting
     
    'Vérification de la clé du registre concernant le menu contextuel
      VerifRegEntry
    'Utilisation du menu contextuel
    Set fso = CreateObject("Scripting.FileSystemObject") 
    Set oArgs = Wscript.Arguments
     
    If oArgs.Length = 0 Then Wscript.Quit
    'If LCase(fso.GetExtensionName(oArgs(0))) ="jpg" Then ' si uniquement pour fichier jpg
        strPath = fso.GetFile(fso.GetFile(oArgs(0)).ShortPath).ParentFolder & "\"  
        NewFile = strPath & "\" & fso.GetBaseName(fso.GetFile(oArgs(0)).Path) & ".txt" 
        If fso.FileExists(NewFile) Then 
           If MsgBox("Le fichier " & NewFile & " existe," & vbNewLine & "Le remplacer ?", vbYesNo, "Remplacer un fichier") = vbNo Then 
               bReplace = False
               OpenExisting = 1
           Else 
               bReplace = True
               OpenExisting = 2
           End If
        Else 
           bReplace = True
           OpenExisting = 2
        End If
        Set Fich = fso.OpenTextFile(NewFile, OpenExisting, bReplace) 
        Fich.Close
    'End If
    '================================
    Sub VerifRegEntry()
     
       Const ContextMenuName = "Créer fichier texte de même nom que la sélection"
     
       Dim WS, App_Path, Key
       Key = "HKCR\*\Shell\" & ContextMenuName & "\Command\"
       Set WS = CreateObject("Wscript.Shell")
       App_Path = Wscript.FullName
     
       With WS
          On Error Resume Next ' nécessaire car si la clé n'existe pas, il y a erreur.
          If .RegRead(Key) = "" Or _
             .RegRead(Key) <> App_Path & " " & Chr(34) & Wscript.ScriptFullName & Chr(34)  & " " & Chr(34) & "%1" & Chr(34) Then
                  .RegWrite Key, App_Path & " " & Chr(34) & Wscript.ScriptFullName & Chr(34) & " " & Chr(34) & "%1" & Chr(34)
          Else
            Exit Sub
          End If
       End With
       Set WS = Nothing
    End Sub
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA) et Ne jamais typer variables et/ou fonctions en VBS.
    Vous pouvez consulter mes contributions
    Ne pas oublier de consulter les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  4. #4
    Candidat au Club
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    juin 2012
    Messages
    7
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Technicien maintenance

    Informations forums :
    Inscription : juin 2012
    Messages : 7
    Points : 4
    Points
    4
    Par défaut Wow! Merci pour votre rapidité! :D
    Voici le code du fichier dont je parlais au départ :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    Option Explicit
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '               Script :    fichier-dossier+txt.vbs
    '               Version : 1.0
    '               Date : 2/09/2004
    '               http://julotsoft.free.fr
    '
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '
    'Script recevant par clic-droit (Explorateur Windows) ou un glisser-déposer,
    'en argument un fichier ou un dossier,
    'de créer automatiquement un fichier texte de même mon.
    ' ex:   toto.jpg -> toto.txt
    '
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    'Déclaration générale
    dim fso
    Set fso=CreateObject("Scripting.FileSystemObject")
    Dim shell
    Set shell = WScript.CreateObject("WScript.Shell")
    Dim objArgs, shortFilePath, gszlongFilePath, gszChemin
    dim gszNomCourtSansExt, gszNomCourtIndex, gszNomCourt, szExt
    const gszTITLE="Fichier-Dossier+txt"
    dim giIndex
    giIndex=0
    
    
    'récupération de l'emplacement du fichier sélectionné dans l'explorateur
    set objArgs=WScript.Arguments
    
    If objArgs.Count=0 Then
      Msgbox "Pour utiliser le créateur de fichier-dossier+txt," & vbLF & _
            "cliquez-droit sur un fichier dans l'Explorateur Windows,", 64, gszTITLE
      WScript.Quit
    End if
    
    'portion code from Mickaël Harris (MVP Microsoft Scripting)
    shortFilePath=objArgs(0)
    With WScript.CreateObject("WScript.Shell").CreateShortcut("anyfile.lnk")
      .TargetPath = shortFilePath
      gszlongFilePath = .TargetPath 'on le nom long
    End With
    'end of Mickaël Harris contribution
    
    
    gszChemin= ExtractFilePath(gszlongFilePath)
    szExt=fso.GetExtensionName(gszlongFilePath) 'renvoie "" si dossier
    gszNomCourt=ExtractFileName(gszlongFilePath)
    
    if  szExt="" then ' "Dossier"
            gszNomCourtSansExt=gszNomCourt
    else '  "Fichier"
            gszNomCourtSansExt=ExtractFileSimpleName(gszlongFilePath)
    end if
    'ici on a : gszNomCourtSansExt et le chemin : gszChemin
    
    
    Call  ProcNouvTxt
    
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '               Procédure principale
    '
    '       Lance la création d'un fichier *.txt avec le nom du fichier
    '       Lance la vrai gestion d'erreur
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Sub ProcNouvTxt()
            dim bRetour
    
            gszNomCourtIndex=gszNomCourtSansExt & szFoncIndex(giIndex)
            bRetour=bCreationFichierTxt(gszChemin,gszNomCourtIndex,False)
            ActionSuivre(bRetour)
    
    End Sub
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '       Après la création, VRAI gestion de l'erreur
    '
    '       l'argument est ce qui est renvoyé par la création du fichier texte
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Sub ActionSuivre(bCas)
            Dim iMsg, bRetour
    
            Select Case bCas
                    'Case 1 'tout va bien
                    Case 2 'erreur inconnue
                    Msgbox "Il y a eu l'erreur : " & Err.Description , 64, gszTITLE
                            
                    Case 0 'fixé déjà existant
                    iMsg=Msgbox("Le fichier : " &  gszNomCourtIndex & ".txt" & _
                            " existe déjà." & vbNewline & vbNewline & _
                            "Voulez-vous :" & vbNewline & _
                            "- Créer un fichier : " & gszNomCourtSansExt &_
                            szFoncIndex(giIndex+1) & ".txt  (Oui)" & vbNewline & _
                            "- Ecraser le fichier : " & gszNomCourtIndex &_
                            ".txt  (Non)" & vbNewline & _
                            "- Annuler l'opération  (Annuler)",vbYesNoCancel+vbQuestion,gszTITLE)
                    if iMsg=2 Then Exit Sub 'vbCancel
                    if iMsg=6 Then' vbYes +1
                            giIndex=giIndex+1
                            gszNomCourtIndex=gszNomCourtSansExt & szFoncIndex(giIndex)
                            bRetour=bCreationFichierTxt _
                                    (gszChemin,gszNomCourtIndex,False)
                            ActionSuivre(bRetour)
                    End If
                    if iMsg=7 Then 'vbNo Ecrasement
                             bRetour=bCreationFichierTxt _
                                    (gszChemin,gszNomCourtIndex,True)
                            ActionSuivre(bRetour)
                    End If
                            
            End Select
    End Sub
                    
    '===========================================================================
    'Fonction de création du fichier .txt
    'Gestion interne de l'erreur de création de fichier
    'Retour :       0 si le fichier existe déjà
    '               1 si l'opération se passe bien + ouverture du fichier
    '               2 si une autre erreur
    '===========================================================================
    Function bCreationFichierTxt(szLechemin,szNomCourt,bEcrasement)
            dim MyFile, commande
            On Error Resume Next
            set MyFile=fso.CreateTextFile(szLeChemin+szNomCourt & ".txt", bEcrasement)
    
            If Err.Number=58 then 'déjà le fichier
                    bCreationFichierTxt=0
                    Exit Function
            End if
            if Err.Number<>0 then
                    bCreationFichierTxt=2 'autre erreur
                    exit function
            end if
    
            bCreationFichierTxt=1 'tout va bien
            MyFile.Close
    
            commande=shell.ExpandEnvironmentStrings("%windir%\notepad.exe" &_
                    " " & Chr(34) & szLeChemin & szNomCourt & ".txt" & Chr(34))
            shell.Run commande, 1
    End Function
    
    '===========================================================================
    '       Fonction szFoncIndex
    'argument : un integer :iindex
    'retour : un string qui pour iindex=0 vaut ""
    '               et pour les autres vaut "_" + iindex
    '===========================================================================
    Function szFoncIndex(iindex)
            if iindex=0 then
                    szFoncIndex=""
            else
                    szFoncIndex="_" & CStr(iindex)
            end if
    End Function
    
    
    '===========================================================================
    '                          ExtractFileName
    ' VBS Factory Library - (c) 2003 Astase - www.astase.com
    '---------------------------------------------------------------------------
    'Usage :  Renvoie le nom du fichier à partir d'un chemin d'accès donné
    '============================================================================
    Function ExtractFileName(File)
      Dim PathToFile
      PathToFile = File
      If Trim(PathToFile)="" Then PathToFile=Wscript.ScriptFullName
      ExtractFileName = Trim(Mid(PathToFile,Len(Left(PathToFile, InStrRev(PathToFile, "\")))+1))
    End Function
    
    '===========================================================================
    '                          ExtractFileSimpleName
    ' VBS Factory Library - (c) 2003 Astase - www.astase.com
    '---------------------------------------------------------------------------
    'Usage :  Renvoie le nom d'un fichier sans son extension
    'Requiert ExtractFileName.
    '============================================================================
    Function ExtractFileSimpleName(File)
      Dim PathToFile
      PathToFile = File
      If Trim(PathToFile)="" Then PathToFile=Wscript.ScriptFullName
      If InStr(PathToFile,"\")<>0 Then PathToFile=ExtractFileName(PathToFile)
      ExtractFileSimpleName = Trim(Left(PathToFile, InStrRev(PathToFile, ".")-1))
    End Function
    
    '===========================================================================
    '                          ExtractFilePath
    ' VBS Factory Library - (c) 2003 Astase - www.astase.com
    '---------------------------------------------------------------------------
    'Usage :  Renvoie le répertoire parent au fichier passé en paramètre
    '============================================================================
    Function ExtractFilePath(File)
      Dim PathToFile
      PathToFile = File
      If Trim(PathToFile)="" Then PathToFile=Wscript.ScriptFullName
      ExtractFilePath = Trim(Left(PathToFile, InStrRev(PathToFile, "\")))
    End Function

  5. #5
    Candidat au Club
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    juin 2012
    Messages
    7
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Technicien maintenance

    Informations forums :
    Inscription : juin 2012
    Messages : 7
    Points : 4
    Points
    4
    Par défaut Euuuuh!
    Un truc idiot que je n'ai pas essayé avant de vous ennuyer avec mes histoires c'était de désinstaller et réinstaller (.exe) le script... évidemment, après ça refonctionne!!!
    Néanmoins, comment dois-je procéder pour tester le tien @l_autodidacte? Faut compiler?
    J'avais prévenu... vbs et moi... cela fait 2!

  6. #6
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    juillet 2009
    Messages
    2 273
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : juillet 2009
    Messages : 2 273
    Points : 5 385
    Points
    5 385
    Par défaut
    Je l'ai déjà signalé dans le post #3 : "Une première exécution du script sans arguments est nécessaire pour faire apparaitre le menu contextuel voulu.
    Le script peut être placé n'importe où et il saura mettre à jour son chemin dans la base du registre
    "
    sauf que je n'ai traité que le cas des fichiers.
    Pour un dossier, ce sera simple en s'inspirant du code pour un fichier.
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA) et Ne jamais typer variables et/ou fonctions en VBS.
    Vous pouvez consulter mes contributions
    Ne pas oublier de consulter les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  7. #7
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    juillet 2009
    Messages
    2 273
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : juillet 2009
    Messages : 2 273
    Points : 5 385
    Points
    5 385
    Par défaut
    Voici une autre version qui tient compte des dossiers, soit par Glisser/Déposer soit par clic droit sur un élément ou une sélection multiple puis choix du menu contextuel "Crée fichier texte de même nom que la sélection".
    Le(s) fichier(s) créé(s) sera(seront) ouvert(s).
    Si un fichier existe déjà, on a le choix de le remplacer ou le laisser tel qu'il est.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    Option Explicit 
     
    Dim fso, Fich, oArgs, strPath, NewFile, bReplace
    Dim OpenExisting, tmpName, I, IsFolder
    'Vérification de la clé du registre concernant le menu contextuel
      VerifRegEntry
    'Utilisation du menu contextuel
    Set fso = CreateObject("Scripting.FileSystemObject") 
    Set oArgs = Wscript.Arguments
     
    If oArgs.Length = 0 Then Wscript.Quit
    ' On traite un ensemble d'éléments sélectionnés(fichiers / dossiers)
    For I = 0 To oArgs.Count - 1
        IsFolder = (fso.GetExtensionName(oArgs(I)) = "")
     
        If IsFolder Then 
           strPath = fso.GetFolder(oArgs(I)).Path
           tmpName = fso.GetFolder(strPath).Name
           strPath = fso.GetFolder(strPath).ParentFolder & "\"
           NewFile = strPath & tmpName & ".txt"
        Else  
           strPath = fso.GetFile(fso.GetFile(oArgs(I)).ShortPath).ParentFolder & "\"  
           NewFile = strPath & fso.GetBaseName(fso.GetFile(oArgs(I)).Path) & ".txt" 
        End If
        If fso.FileExists(NewFile) Then 
           If MsgBox("Le fichier " & NewFile & " existe déjà." & vbNewLine _
           & vbNewLine & vbTab & "Voulez-vous le remplacer ?", vbYesNo, _
           "Remplacer un fichier") = vbNo Then 
               bReplace = False
               OpenExisting = 1
           Else 
               bReplace = True
               OpenExisting = 2
           End If
        Else 
           bReplace = True
           OpenExisting = 2
        End If
        Set Fich = fso.OpenTextFile(NewFile, OpenExisting, bReplace) 
        Fich.Close
        CreateObject("Wscript.Shell").Run fso.GetFile(NewFile).ShortPath, 1, True
    Next 
    '================================
    Sub VerifRegEntry()
     
       Const ContextMenuName = "Créer fichier texte de même nom que la sélection"
       Const RAC = "HKCR\Folder\Shell\"
       Dim WS, App_Path, KeyAllFiles, KeyFolders, ScriptAndOptions
     
       ScriptAndOptions = " " & Chr(34) & Wscript.ScriptFullName & Chr(34)  & " " & Chr(34) & "%1" & Chr(34)
       KeyAllFiles = "HKCR\*\Shell\" & ContextMenuName & "\Command\"
       KeyFolders  = RAC & ContextMenuName & "\Command\" 
       Set WS = CreateObject("Wscript.Shell")
       App_Path = Wscript.FullName
     
       With WS
          On Error Resume Next ' nécessaire car si la clé n'existe pas, il y a erreur.
          If .RegRead(KeyAllFiles) = "" Or _
             .RegRead(KeyAllFiles) <> App_Path & ScriptAndOptions  Then
                  .RegWrite KeyAllFiles, App_Path & ScriptAndOptions
          End If
          If .RegRead(KeyFolders) = "" Or _
             .RegRead(KeyFolders) <> App_Path & ScriptAndOptions Then
                  .RegWrite KeyFolders, App_Path & ScriptAndOptions
          End If
       End With
       Set WS = Nothing
    End Sub
    NB : Il faut exécuter le script une seule fois par double-clic dessus; ceci correspond à son installation.
    Ensuite, si on fait un clic droit sur un fichier, dossier ou une sélection multiple, on verra le menu contextuel(cité plus haut) apparaitre.
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA) et Ne jamais typer variables et/ou fonctions en VBS.
    Vous pouvez consulter mes contributions
    Ne pas oublier de consulter les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  8. #8
    Candidat au Club
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    juin 2012
    Messages
    7
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Technicien maintenance

    Informations forums :
    Inscription : juin 2012
    Messages : 7
    Points : 4
    Points
    4
    Par défaut


    Mille Mercis!!!

  9. #9
    Candidat au Club
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    juin 2012
    Messages
    7
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Technicien maintenance

    Informations forums :
    Inscription : juin 2012
    Messages : 7
    Points : 4
    Points
    4
    Par défaut
    Ooops! Rien ne se produit après double click.
    Et après click droit sur un fichier je ne vois pas, dans le menu contextuel, "Créer fichier texte de même nom que la sélection"

  10. #10
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    juillet 2009
    Messages
    2 273
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : juillet 2009
    Messages : 2 273
    Points : 5 385
    Points
    5 385
    Par défaut
    C'est peut-être parce que tu n'as le droit d'accès au registre Windows.

    Essaie de lancer Regedit.exe depuis menu Exécuter (tu tapes Regedit puis OK).
    Si le registre ne s'ouvre pas, cela confirme le manque de droits d'accès.

    Dans un tel cas, Clic droit sur Regedit.exe / Propriétés / Sécurité
    Choisis ton nom d'utilisateur dans la liste et modifie les entrés pour avoir le contrôle total de l'application.

    Essaie ensuite en lançant le script par un double clic. Regarde si le menu en question apparait ou non.
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA) et Ne jamais typer variables et/ou fonctions en VBS.
    Vous pouvez consulter mes contributions
    Ne pas oublier de consulter les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  11. #11
    Candidat au Club
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    juin 2012
    Messages
    7
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Technicien maintenance

    Informations forums :
    Inscription : juin 2012
    Messages : 7
    Points : 4
    Points
    4
    Par défaut
    J'ai bien accès à la base de registre etc. :/

  12. #12
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    juillet 2009
    Messages
    2 273
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : juillet 2009
    Messages : 2 273
    Points : 5 385
    Points
    5 385
    Par défaut
    J'ai quand même des doutes sur l'accès du script au registre.

    Modifie le script de façon à remplacer la Sub VerifRegEntry par cette nouvelle version, en ajoutant la fonction qui lit le nom du menu contextuel telle que ci-après :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    Sub VerifRegEntry()
       Const HKCR = &H80000000
       Const ContextMenuName = "Créer fichier texte de même nom que la sélection" 
       Const RAC = "HKCR\Folder\Shell\"
       Dim WS, App_Path, KeyAllFiles, KeyFolders, ScriptAndOptions
     
       ScriptAndOptions = " " & Chr(34) & Wscript.ScriptFullName & Chr(34)  & " " & Chr(34) & "%1" & Chr(34)
       KeyAllFiles = "HKCR\*\Shell\" & ContextMenuName & "\Command\"
       KeyFolders  = RAC & ContextMenuName & "\Command\" 
       Set WS = CreateObject("Wscript.Shell")
       App_Path = Wscript.FullName
     
       With WS
          If Not RegEntryExists(HKCR, "*\Shell\") Then
             .RegWrite KeyAllFiles, App_Path & ScriptAndOptions
          End If
     
          If Not RegEntryExists(HKCR, "Folder\Shell\") Then
             .RegWrite KeyFolders, App_Path & ScriptAndOptions
          End If
       End With
       Set WS = Nothing
    End Sub
    '==============================
    Function RegEntryExists(sHive, sEnumPath)
        Dim  objRegistry, lRC
        Dim wmiLocator, wshNetwork, wmiNameSpace, Mycomputer
        Dim sNames, sKeyName, IsThere
        IsThere = False   
        Set wmiLocator = CreateObject("WbemScripting.SWbemLocator")
        Set wshNetwork = CreateObject("WScript.Network")
        Mycomputer = wshNetwork.ComputerName
        Set wmiNameSpace = wmiLocator.ConnectServer(Mycomputer, "root\default")
        Set objRegistry = wmiNameSpace.Get("StdRegProv")
     
        lRC = objRegistry.EnumKey(sHive, sEnumPath, sNames)
        For Each sKeyName In sNames
          If sKeyName = ContextMenuName Then 
             IsThere = True
             Exit For
          End If
        Next
        RegEntryExists = IsThere
    End Function
    Pour vérifier si la fonction retourne une valeur(booléenne) ou non, tu peux ajouter les instructions :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    MsgBox RegEntryExists(HKCR, "*\Shell\")
    MsgBox RegEntryExists(HKCR, "Folder\Shell")
    soit à la fin du script ou au début sans oublier de définir HKCR au début du script.
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA) et Ne jamais typer variables et/ou fonctions en VBS.
    Vous pouvez consulter mes contributions
    Ne pas oublier de consulter les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  13. #13
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    juillet 2009
    Messages
    2 273
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : juillet 2009
    Messages : 2 273
    Points : 5 385
    Points
    5 385
    Par défaut
    Le script que tu as évoqué ne crée pas de menu contextuel(lors d'un clic droit sur un dossier ou un fichier).

    Quoique tu n'aies fait aucune riposte à mon dernier post, je t'envoie le script complet qui doit faire le boulot qu'on attend.

    J'ai encore fignolé le script de façon à être sûr que c'est la bonne ligne de commande qui est inscrite dans le registre.
    Comme déjà dit dans un post précédent, le script s'installe par double-clic(ou en y déposant un fichier ou un dossier).
    Un message de confirmation apparaitra une seule fois.
    Si on essaie d'exécuter le script une seconde fois par double-clic, un autre message fera savoir que le script est déjà installé.

    L'utilisation du script se fait soit par clic droit sur un élément(dossier, fichier), une sélection multiple et choisir le menu contextuel en question ou par Glisser/Déposer (fichier, dossier ou sélection multiple):
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    Option Explicit 
    
    Const ContextMenuName = "Créer fichier texte de même nom que la sélection" 
    Const vbDirectory = 16, vbVolume = 8
    Const HKCR = &H80000000 ' HKEY_CLASSES_ROOT
    Const REG_SZ = 1
    Dim fso, Fich, oArgs, strPath, NewFile, bReplace, objReg
    Dim OpenExisting, tmpName, I, WS, ScriptAndOptions, App_Path
    
    App_Path = Wscript.FullName
    ScriptAndOptions = " " & Chr(34) & Wscript.ScriptFullName & Chr(34)  & " " & Chr(34) & "%1" & Chr(34)
    Set WS = CreateObject("Wscript.Shell")
    Set oArgs = Wscript.Arguments
    'Vérification de la clé du registre concernant le menu contextuel
      VerifRegEntry
    'Utilisation du menu contextuel
    Set fso = CreateObject("Scripting.FileSystemObject") 
    
    If oArgs.Length = 0 Then Wscript.Quit
    ' On traite un ensemble d'éléments sélectionnés(fichiers et/ou dossiers)
    ' On utilisera le nom du dernier élément de l'arborescence(fichier ou dossier) au format long
    For I = 0 To oArgs.Count - 1
        If IsFolder(oArgs(I)) Then 
           strPath = GetShortPath(oArgs(I)) 
           tmpName = fso.GetFolder(oArgs(I)).Name
           strPath = fso.GetFolder(strPath).ParentFolder & "\"
           NewFile = strPath & tmpName & ".txt"                          
        ElseIf IsFile(oArgs(I)) Then  
           strPath = GetShortPath(oArgs(I))
           strPath = fso.GetFile(strPath).ParentFolder & "\"
           NewFile = strPath & fso.GetBaseName(oArgs(I)) & ".txt"        
        End If
        If fso.FileExists(NewFile) Then 
           If MsgBox("Le fichier " & NewFile & " existe déjà." & vbNewLine _
           & vbNewLine & vbTab & "Voulez-vous le remplacer ?", vbYesNo, _
           "Remplacer un fichier") = vbNo Then 
               bReplace = False
               OpenExisting = 1
           Else 
               bReplace = True
               OpenExisting = 2
           End If
        Else 
           bReplace = True
           OpenExisting = 2
        End If
        Set Fich = fso.OpenTextFile(NewFile, OpenExisting, bReplace) 
        Fich.Close
        WS.Run fso.GetFile(NewFile).ShortPath, 1, False
    Next 
    ' Clean up environment objects :
    Set fso = Nothing : Set Fich = Nothing : Set WS = Nothing : Set oArgs = Nothing
    
    '================================
    Sub VerifRegEntry()
    
       Const RAC = "HKCR\Folder\Shell\"
       Dim KeyAllFiles, KeyFolders
       Dim intFlag1, intFlag2
    
       KeyAllFiles = "HKCR\*\Shell\" & ContextMenuName & "\Command\"
       KeyFolders  = RAC & ContextMenuName & "\Command\" 
       intFlag1 = 0  :  intFlag2 = 0
       With WS
          If Not RegEntryExists(HKCR, "*\Shell\", App_Path & ScriptAndOptions) Then
             .RegWrite KeyAllFiles, App_Path & ScriptAndOptions
             intFlag1 = 1
          End If
          
          If Not RegEntryExists(HKCR, "Folder\Shell\", App_Path & ScriptAndOptions) Then
             .RegWrite KeyFolders, App_Path & ScriptAndOptions
             intFlag2 = 2
          End If
       End With
      ' Informations sur l'installation du script
       If intFlag1 + intFlag2  >= 1 Then 
            MsgBox "Installation terminée avec succès("  & intFlag1 + intFlag2  & ")" & vbNewLine & vbNewLine & _
            "Ligne de commande : " & vbNewLine & WS.RegRead(KeyAllFiles)
       Else
           ' Installation déjà faite, pas besoin de le mentionner 
           ' sauf si on exécute le sctipt sans arguments 
           If oArgs.Count = 0 And intFlag1 + intFlag2 = 0 Then MsgBox "Installation déjà faite auparavant !", , "Script installé"
       End If  
    End Sub
    '==============================
    Function RegEntryExists(sHive, sEnumPath, MenuData)
        Dim  lRC, ValueExists
        Dim wmiLocator, wshNetwork, wmiNameSpace, Mycomputer 
        Dim sNames, sKeyName, IsThere
        IsThere = False   
        Set wmiLocator = CreateObject("WbemScripting.SWbemLocator")
        Set wshNetwork = CreateObject("WScript.Network")
        Mycomputer = wshNetwork.ComputerName
        Set wmiNameSpace = wmiLocator.ConnectServer(Mycomputer, "root\default")
        Set objReg = wmiNameSpace.Get("StdRegProv")
        
        lRC = objReg.EnumKey(sHive, sEnumPath, sNames)
        For Each sKeyName In sNames
          If sKeyName = ContextMenuName Then 
             IsThere = True
             Exit For
          End If
        Next
        If IsThere Then 
            Dim bExiste, lRet1, lRet2, sValue , strFullRegPath
            
            strFullRegPath = sEnumPath & ContextMenuName & "\Command\"
            lRet1 = objReg.EnumValues(HKCR, strFullRegPath, "", REG_SZ) 
            lRet2 = objReg.GetStringValue(HKCR, strFullRegPath, "", sValue)
            bExiste = (sValue = MenuData ) 
        End If
        RegEntryExists = bExiste And IsThere ': MsgBox bExiste And IsThere
    End Function
    '=======================
    Function GetShortPath(strElem)
      Dim f', fso
      'Set fso = CreateObject("Scripting.FileSystemObject")
    
      If IsFolder(strElem) Then
         GetShortPath = fso.GetFolder(strElem).ShortPath
      ElseIf IsFile(strElem) Then
         GetShortPath = fso.GetFile(strElem).ShortPath
      End If     
    End Function
    '===========================
    Function IsFolder(strElement)
        Dim Attr, F', fso
        'Set fso = CreateObject("Scripting.FileSystemObject")
        On Error Resume Next 
        Set F = fso.GetFolder(strElement)
    
        IsFolder = ((F.Attributes And vbDirectory) = vbDirectory)
       ' Set fso = Nothing
    End Function       
    '============================
    Function IsFile(strElement)    
        Dim F ', fso
        'Set fso = CreateObject("Scripting.FileSystemObject")
        On Error Resume Next
        Set F = fso.GetFile(strElement)
    
        IsFile = ((F.Attributes And vbDirectory) <> vbDirectory or vbVolume)
        'Set fso = Nothing
    End Function
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA) et Ne jamais typer variables et/ou fonctions en VBS.
    Vous pouvez consulter mes contributions
    Ne pas oublier de consulter les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 2
    Dernier message: 01/11/2014, 10h27
  2. [Images] Créer un fichier jpg à partir d'un champ blog mysql
    Par lolodev dans le forum Bibliothèques et frameworks
    Réponses: 2
    Dernier message: 23/07/2011, 14h06
  3. Flash Pascal : Compilateur permettant de créer des fichiers SWF (Flash)
    Par forum dans le forum Outils à télécharger
    Réponses: 3
    Dernier message: 07/04/2011, 13h26
  4. Créer un fichier jpg a partir de plusieurs fichiers
    Par tryonyco dans le forum C++Builder
    Réponses: 1
    Dernier message: 24/06/2009, 11h37
  5. Scripts VBS + DOS - sortie dans un fichier de logs
    Par kayanwan dans le forum VBScript
    Réponses: 8
    Dernier message: 14/09/2007, 15h34

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo