Créer raccourci internet à partir d'une colonne

Bonjour à toutes et à tous,

J'ai cherché sur le forum, et n'ai malheureusement pas trouvé chaussure à mon pied....

J'ai trouvé un code sur internet me permettant de créer un raccourci url sur bureau (ou autre dossier, au choix) d'un lien internet déterminé dans une cellule.

Cela fonctionne super bien, mais je n'arrive pas à adapter ce code à mon goût, mes compétences étant hyper limitées....

Pour le moment j'arrive à créer un raccourci url au nom de mon choix pour l'adresse présente dans la cellule A1.

C'est là que je fais appel à vous pour me donner un petit coup de pouce ! Comment générer automatiquement des raccourcis dans un dossier prédéfini à partir de la colonne A contenant des adresses, et les renommer du nom de la colonne B ? Sachant que toutes les cellules de la colonne A ne sont pas forcément remplies, il peut y avoir des vides.

Sub raccourcis_bureau()
Open "C:\Users\station\desktop\lien0001.url" For Output As #1
Print #1, "[InternetShortcut]"
Print #1, Chr$(10) & "URL=" & Range("a1")
Close #1
End Sub

Ci-dessus le code trouvé. A adapter, ou un nouveau code ?

Je joins également un fichier exemple.

Je vous remercie d'avance mille fois pour votre aide, vous me feriez gagner un max de temps !! Car c'est un peu chronophage de créer les raccourcis un par un...

Cordialement

Bonjour clairedost

Je ne comprends pas bien votre demande

Comment générer automatiquement des raccourcis dans un dossier prédéfini à partir de la colonne A contenant des adresses

Dans la colonne A je ne vois pas des adresses mais des url... quid du dossier prédéfini !?

A+

Bonjour Bruno

Ok je n'ai peut-être pas utilisé les bons termes...🙄

Dans la colonne A il n'y aura exclusivement que des URL (qui sont extraits d'une base de données qu'on me fournit). J'ai besoin d'avoir dans un dossier des raccourcis de ces URL renommés à ma guise.

J'espère que je me suis faite comprendre.... désolée si c'est pas très clair...

et le dossier de destination, en effet, l'idéal est de pouvoir le choisir au lancement de la macro (d'autres personnes auront accès à ce fichier sur des postes différents).

Re,

Ok je comprends mieux

Donc voici une possibilité de code qui remplace l'existant

Sub CréerRaccourcis()
  Dim sPath As String
  Dim dLig As Long, Lig As Long
  Dim sUrl As String, sLien As String
  ' Définir le chemin du fichier ICI
  sPath = "C:\Temp\"
  ' Avec la feuille active
  With ThisWorkbook.ActiveSheet
    ' Dernière ligne remplie de la feuille
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 1 To dLig
      ' Récupérer la valeur de la cellule = URL
      sUrl = .Range("A" & Lig).Value
      ' Si l'URL n'est pa svide
      If sUrl <> "" Then
        ' Récupérer le nom du lien à créer
        sLien = .Range("B" & Lig).Value
        Open sPath & sLien For Output As #1
        Print #1, "[InternetShortcut]"
        Print #1, Chr$(10) & "URL=" & sUrl
        Close #1
      End If
    Next Lig
  End With
End Sub

A+

Bonjour Bruno,

Désolée, je n'avais pas vu votre message hier soir.

Je viens de tester votre proposition, et ça marche à merveille !!!

Je ne sais pas comment vous remercier, si je pouvais vous prendre dans mes bras, je le ferais !

Je vais gagner un temps considérable grâce à vous.

Franchement, je ne sais pas comment vous faites tous. A croire que le codage est une langue innée chez vous, ça a l'air si facile pour vous !

Moi je passe des heures sur un petit bout de code !

Encore un énorme MERCI !!!!! Et félicitations à vous Bruno et à tous les membres pour vos compétences et votre rapidité !

Une très belle journée à vous tous !

Bonjour Claire

Merci pour ce super retour qui fait chaud au coeur

Tout comme Obelix, je suis tombé dans la marmite... mais du VBA

Belle journée à vous

vous n'avez à me remercier, c'est le moindre que je puisse faire pour vos retours.

faut vraiment que je pense à prendre de vrais cours ! excel est aussi une passion pour moi, mais je suis tout tout en bas !

Re,

Nous avons tous commencé un jour