Microsoft 365 VBA Excel Création de raccourcis Windows à partir d'URL dans un colonne

INFSON · 6 Juin 2021

Bonjour

Question pour un spécialisate en VBA EXCEL

J’ai adapté une macro VBA trouvé sur un site

Elle ne fonctionne pas comme je le souhaite

Soit le fichier excel en pièce jointe

Col A = Nom Souhaité d’url
Col B = Destination pour les raccourcis à Générer
( user \BRUNO2\ à changer dans cette colonne )
Col C = Url Youtube

1/ Cette routine ne fonctionne que si on la laisse liée au fichier excel
si je la déplace dans le fichier PERSONAL.XLSB des macros communes elle plante
motif Microsoft Visual Basic
Erreur d'exécution '-2147024891 (80070005):
Impossible d'enreqistrer le raccourci "C :\.Ink".

Pourquoi ?
Est-ce normal en raison du fait que la routine agit hors d' excel ?

2/ j’aurai souhaité récupérer une extension type .url et non .ink
afin que le raccourci puisse fonctionner dans l'environnement android
est-ce possible ?

si je remplace usb par ink dans la routine elle plante
motif Erreur d'exécution '438'
Propriété ou méthode non gérée par cet objet

Quel OBJET faut il utiliser ?

Merci d’avance

Le code repris ci-dessous du fichier https://www.cjoint.com/c/KFdrmAfpfHT
dans le fichier Excel e

Sub LinkCreateTranspo()
Dim ScrHst As Object, Raccourci As Object
Dim LastLig As Long, i As Long
Dim Emplacement As String

Set ScrHst = CreateObject("WScript.Shell")
LastLig = Feuil1.Cells(Feuil1.Rows.Count, 3).End(xlUp).Row
For i = 2 To LastLig
Emplacement = Feuil1.Range("B" & i)
Set Raccourci = ScrHst.CreateShortcut(Emplacement & "\" & Feuil1.Range("A" & i) & ".lnk")
With Raccourci
.WorkingDirectory = Emplacement
.TargetPath = Feuil1.Range("C" & i)
.Save
End With
Next i
Set Raccourci = Nothing
Set ScrHst = Nothing
End Sub

Merci d'avance

fanch55 · 6 Juin 2021

Bonsoir,
En modifiant légèrement la feuille :

Le code ci-dessous devrait le faire :

VB:

Sub LinkCreateTranspo()
Dim Emplacement As String, Word As Variant, Ligne As Range
With Worksheets("Feuil1")
    For Each Ligne In .Rows("2:" & .Cells(.Rows.Count, 3).End(xlUp).Row)
        With CreateObject("WScript.Shell")
            Emplacement = .SpecialFolders("Desktop") & "\"
            For Each Word In Split(Ligne.Cells(2), "\")
                Emplacement = Emplacement & Word & "\"
                If Dir(Emplacement, vbDirectory) = "" Then MkDir Emplacement
            Next
            With .CreateShortcut(Emplacement & "\" & Ligne.Cells(1) & ".url")
                .TargetPath = Ligne.Cells(3)
                .Save
            End With
        End With
    Next
End With
End Sub

Nota: pas de problème particulier en le plaçant dans le personnal.xlsb

Je n'ai pas compris le terme USB ?

soan · 7 Juin 2021

Bonjour INFSON, fanch55,

bienvenue sur le site XLD !

tu as écrit : « Impossible d'enregistrer le raccourci "C :\.Ink". » et :

« 2/ j’aurai souhaité récupérer une extension type .url et non .ink »

et : « si je remplace usb par .ink dans la routine elle plante »

manque de pot, pour les raccourcis Windows qui sont des Liens vers des fichiers (en anglais : Link), l'extension est .lnk (avec un L minuscule, bien que .Lnk serait ok aussi) ; j'ai précisé « liens vers des fichiers » pour éviter toute confusion entre « raccourcis fichiers » et « raccourcis clavier ».

et puis surtout, pour ton raccourci "C :\.Ink", même si tu l'écris "C :\.lnk" ça ne peut vraiment pas marcher comme ça ! tu dois mettre par exemple "C :\*.lnk" ou "C:\nom.lnk".

« ink » existe aussi : c'est l'encre des imprimantes.

mébon, j'viens d'voir que dans ton code VBA, tu as bien mis ".lnk" et pas ".ink" ; alors si ça plante quand même, c'est peut-être car une des cellules est vide ? ➯ ça aboutit à : "C :\.lnk" !

@fanch55

tu as écrit : « Je n'ai pas compris le terme USB ? »

pour « USB », je connais les clés USB et les ports USB ; mais dans la phrase d'INFSON « si je remplace usb par ink dans la routine elle plante », j'vois pas quel est le rapport avec les clés USB ou les ports USB ; peut-être que le fichier est sur une clé USB externe, et pas sur le disque dur du PC ?

rappel : USB = « Universal Serial Bus » = bus en série universel ; plus d'infos ICI.

soan

INFSON · 7 Juin 2021

Bonjour

Merci pour vos réponses
Je vais essayer dans la journée de tester le code proposé

En ce qui concerne

"si je remplace usb par ink dans la routine elle plante"

c'est hélas une erreur de rédaction de ma part

j'aurai du écrire
"si je remplace ink par url dans la routine elle plante"

bref il faut toujours relire attentivement ses posts ;-)

désolé

INFSON · 7 Juin 2021

J'ai testé sur mon PC la routine s'arrête du l'emplacement en Gras ci-dessous

Bruno

Sub CORRECTION_LinkCreateTranspo()
Dim Emplacement As String, Word As Variant, Row As Range
With Worksheets("Feuil1")
For Each Row In .Rows("2:" & .Cells(.Rows.Count, 3).End(xlUp).Row)
With CreateObject("WScript.Shell")
Emplacement = .SpecialFolders("Desktop") & "\"
For Each Word In Split(Row.Cells(2), "\")
Emplacement = Emplacement & Word & "\"
If Dir(Emplacement, vbDirectory) = "" Then MkDir Emplacement
Next
With .CreateShortcut(Emplacement & "\" & Row.Cells(1) & ".url")
.TargetPath = Row.Cells(3)
.Save
End With
End With
Next
End With
End Sub

fanch55 · 7 Juin 2021

Qu'y a-t-il dans emplacement ?

soan · 7 Juin 2021

@fanch55

dans Emplacement, y'a au départ l'dossier spécial du Bureau, avec "\" final :

Emplacement = .SpecialFolders("Desktop") & "\"

puis dans la boucle For, y'a :

Emplacement = Emplacement & Word & "\"

et la ligne For est :

For Each Word In Split(Row.Cells(2), "\")

mais Row.Cells(2) me paraît bizarre !

soan

fanch55 · 7 Juin 2021

soan à dit:
@fanch55

dans Emplacement, y'a l'dossier spécial du Bureau :

Emplacement = .SpecialFolders("Desktop") & "\"

soan

Ce devrait être cela effectivement.

Cependant, je viens de remarquer que @INFSON est sur microsoft 365 .

J'ai connu beaucoup de déboires avec la commande DIR qui fonctionne correctement sur les versions < 2019 mais qui semble provoquer systématiquement une erreur sur 365 quand le pathname spécifié n'existe pas.
IL faudrait peut-être mettre un "on error resume next" ...
Je n'ai pas la version 2019 ou Office 365 .

soan · 7 Juin 2021

@fanch55

excuse-moi, j'ai complété mon post #7 au fur et à mesure ; il est maintenant bien plus long que la citation de ton post #8 ; merci pour tes infos sur microsoft 365, même si moi non plus je ne l'ai pas, ni Excel 2019 : actuellement, j'ai Excel 2007.

soan

INFSON · 7 Juin 2021

Ca fonctionne , j'ai enlevé la première ligne de mon fichier test
qui était un repère du numéro de colonne du fichier à exploiter
la macro ne pouvait pas trouver le chemin colonne B

Mille mercis

fanch55 · 7 Juin 2021

La version sans le Dir :

VB:

Option Explicit
Sub LinkCreateTranspo()
Dim Emplacement As String, Word As Variant, Ligne As Range, Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
    With Worksheets("Feuil1")
        For Each Ligne In .Rows("2:" & .Cells(.Rows.Count, 3).End(xlUp).Row)
            With CreateObject("WScript.Shell")
                Emplacement = .SpecialFolders("Desktop") & "\"
                For Each Word In Split(Ligne.Cells(2), "\")
                    Emplacement = Emplacement & Word & "\"
                    If Not Fso.FolderExists(Emplacement) Then
                        On Error Resume Next
                        Fso.CreateFolder Emplacement
                        If Err > 0 Then
                            MsgBox "le dossier " & Emplacement & " est incorrect", vbCritical + vbOKOnly, "Abandon"
                            Exit Sub
                        End If
                    End If
                Next
                With .CreateShortcut(Emplacement & "\" & Ligne.Cells(1) & ".url")
                    .TargetPath = Ligne.Cells(3)
                    .Save
                End With
            End With
        Next
    End With
Set Fso = Nothing
End Sub

soan · 7 Juin 2021

@INFSON, fanch55,

oh la ! j'avais zappé Dim Row As Range !

il ne faut pas utiliser comme nom de variable un mot-clé VBA ! « Row » est réservé :

soan

fanch55 · 7 Juin 2021

Les propriétés ne sont pas vraiment des mots réservés ( les instructions oui) ...

Mots clés - Visual Basic

En savoir plus sur : Mots clés (Visual Basic)

docs.microsoft.com

Mais tu as raison, pour plus de clarté et ne pas faire de confusion malencontreuse,
il vaut mieux éviter cela, j'ai modifié le post 11 .

soan · 7 Juin 2021

@fanch55

oui, effectivement, une propriété n'est pas un mot-clé réservé du VBA, mais j'ai dit « mot-clé (keyword) » dans un sens vraiment très général : tout c'qui sert d'habitude quand on programme en VBA.

soan

INFSON · 7 Juin 2021

Avec la macro corrigée 11 j'ai désormais une erreur

Microsoft 365 VBA Excel Création de raccourcis Windows à partir d'URL dans un colonne

INFSON

XLDnaute Nouveau

Pièces jointes

fanch55

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

INFSON

XLDnaute Nouveau

INFSON

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

INFSON

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

Mots clés - Visual Basic

soan

XLDnaute Barbatruc

INFSON

XLDnaute Nouveau

Discussions similaires