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

Etoto · 7 Juin 2021

INFSON à dit:
Avec la macro corrigée 11 j'ai désormais une erreurRegarde la pièce jointe 1107734

Bonjour,

Tu as le "C:\" derrière qu'il faut retirer.

Cela doit être : "C:\Users\BRUNO2\Desktop"

INFSON · 7 Juin 2021

Je ne vois pas sur quelle ligne
Sub TEST3()
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

Etoto · 7 Juin 2021

Mieux vaut attendre le point de vue de fanch55, c'est le créateur de la fonction, il trouvera surement le problème

Etoto · 7 Juin 2021

Essaie ça (pas sûr) :

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
                    Emplacement = Left(Emplacement, Len(Emplacement) - 3)
                        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

Mais je sais vraiment pas si ça va marcher.

INFSON · 7 Juin 2021

Non plantage

Etoto · 7 Juin 2021

INFSON à dit:
Non plantage
Regarde la pièce jointe 1107737

Remplace "Left(Emplacement, Len(Emplacement) - 3)"
Par "Left(Emplacement, Len(Emplacement) - 4)"

Peut-être que c'est juste ça le problème.

INFSON · 7 Juin 2021

Non tjrs même bug

Etoto · 7 Juin 2021

INFSON à dit:
Non tjrs même bug
Regarde la pièce jointe 1107739

Sorry, c'est donc c'est pas ça le problème, bizarre, ce chemin existe bel et bien sur l'ordinateur ?

INFSON · 7 Juin 2021

Pour en être sûr j'ai crée un raccourci sur le chemin cible
c'est bien C:\Users\BRUNO2\Desktop\TEST\CIBLE
comme indiqué dans le fichier joint
Je le republie avec les différents hypothèses seul la macro d'origine fonctionne test 1
https://cjoint.com/c/KFhnzkb5GKT

Etoto · 7 Juin 2021

INFSON à dit:
TEST\CIBLE

Cette partie n'est pas dans ton code VB. Mais je suis pas bon en VB.

INFSON · 7 Juin 2021

c'est bizarre j'ai l'impression qu'il y a 2 canaux de lecture
celui ci

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

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...

www.excel-downloads.com

et

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

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...

www.excel-downloads.com

INFSON · 7 Juin 2021

C'est dommage à un moment le post 11 a été modifié
La macro avant la modif mais j'ai pas eu le temps de voir si elle générait des raccourcis de type URL
et non .lnk comme dans Macro test11()

fanch55 · 8 Juin 2021

Bonsoir, désolé, j'étais en déplacement .
Comme je l’indiquai dans le post 2 :

Tel que le code est fait, il ne faut pas indiquer le chemin complet en colonnne J, juste les dossiers cibles .
le code:
Emplacement = .SpecialFolders("Desktop") & "\" donne Emplacement = "c:\Users\BRUNO2\Desktop\"
Ensuite
le code va vérifier et créer les dossiers complémentaires pour chaque mot dans la colonne J :
Emplacement = "c:\Users\BRUNO2\Desktop\TEST\"
et finalement:
Emplacement = "c:\Users\BRUNO2\Desktop\TEST\CIBLE\"

Ceci pour permettre qu'il puisse fonctionner sur n'importe quel PC ou User sans avoir à changer ce qui est en colonne J.

Toutefois, si on veut préciser le chemin en entier ( C:\Users\BRUNO2\Desktop\TEST\CIBLE ) en colonne J,
en ce cas il suffit de remplacer la première assignation :
Emplacement = .SpecialFolders("Desktop") & "\" par Emplacement = vbnullstring
Le code va tenter de créer les dossiers indiqués sans se préoccuper du bureau propre à l'utilisateur .

VB:

Sub TEST3()
Dim Emplacement As String, Word As Variant, Ligne As Range, Fso As Object, Debut As Integer
Set Fso = CreateObject("Scripting.FileSystemObject")
    With Worksheets("Feuil1")
        Debut = 2 ' début des lignes à scruter
        For Each Ligne In .Rows(Debut & ":" & .Cells(.Rows.Count, 3).End(xlUp).Row)
            With CreateObject("WScript.Shell")
                Emplacement = vbNullString
                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" & vbLf & _
                                    Err.Description, 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

Si on ne désire pas que le code se charge de créer un quelconque emplacement mais juste le raccourci,
le code ci-dessous suffit :

VB:

Sub TEST4()
Dim Ligne As Range, Debut As Integer
    On Error Resume Next
    With Worksheets("Feuil1")
        Debut = 2 ' début des lignes à scruter
        For Each Ligne In .Rows(Debut & ":" & .Cells(.Rows.Count, 3).End(xlUp).Row)
            With CreateObject("WScript.Shell")
                With .CreateShortcut(Ligne.Cells(2) & "\" & Ligne.Cells(1) & ".url")
                    .TargetPath = Ligne.Cells(3)
                    .Save
                End With
                If Err Then
                    MsgBox "le raccourci est incorrect" & vbLf & _
                            Err.Description, vbCritical + vbOKOnly, "Abandon"
                    Err.Clear
                End If
            End With
        Next
    End With
End Sub

fanch55 · 8 Juin 2021

INFSON à dit:
c'est bizarre j'ai l'impression qu'il y a 2 canaux de lecture
celui ci

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

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...

www.excel-downloads.com

et

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

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...

www.excel-downloads.com

Non, la discussion est juste composée de 2 pages ( et peut évoluer )

soan · 9 Juin 2021

Bonjour INFSON, fanch55, Etoto,

peut-être que le 2 est en trop ? ce serait alors : C:\Users\BRUNO\Desktop

et donc ensuite : C:\Users\BRUNO\Desktop\TEST\CIBLE

soan

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

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires

Partager cette page

Statistiques des forums