Can I use vba to add hyperlink shortcuts to folders

[Rosanna24]

Hello, I’m new to this forum and trying different ways to increase my knowledge and excel skills. I was asked at work to create 300 folders for schools in our area, and worked out to do it with excel vba from a list. So I was very happy 😃. But each school has a website and I would like to add a shortcut in each folder to the website for that school😕. Does anyone know if I can use vba to help with this ? I’ve looked on YouTube and I just can’t work out how I might do this. I have a file in excel that has all the schools and a hyperlink to each website. Can’t beleive I have to create 300 shortcuts ...

[Leith Ross]

Hello Rosanna24,

Welcome!

This macro assumes you have:


The data is on the Active sheet
Headers in Row 1
The complete folder paths in column "A"
The hyperlinks to the web sites in column "B"
The shortcut text matches the text displayed in the hyperlinks





Sub AddShortcuts()


Dim Cell As Range
Dim LinkName As String
Dim Path As Variant
Dim Rng As Range
Dim URL As String
Dim Wsh As Object

Set Wsh = CreateObject("Wscript.Shell")

Set Cell = Range("A2")

Set Rng = Cells(Rows.Count, Cell.Column).End(xlUp)
If Rng.Row < Cell.Row Then Exit Sub Else Set Rng = Range(Cell, Rng)

For Each Cell In Rng
Path = Cell
Path = IIf(Right(Cell, 1) <> "\", Path & "\", Path)

With Cell.Offset(0, 1).Hyperlinks(1)
LinkName = Path & .TextToDisplay & ".url"
URL = .Address
End With

With Wsh.CreateShortcut(LinkName)
.TargetPath = URL
.Save
End With
Next Cell

End Sub

[Rosanna24]

Hello Rosanna24,

Welcome!

This macro assumes you have:


The data is on the Active sheet
Headers in Row 1
The complete folder paths in column "A"
The hyperlinks to the web sites in column "B"
The shortcut text matches the text displayed in the hyperlinks





Sub AddShortcuts()


Dim Cell As Range
Dim LinkName As String
Dim Path As Variant
Dim Rng As Range
Dim URL As String
Dim Wsh As Object

Set Wsh = CreateObject("Wscript.Shell")

Set Cell = Range("A2")

Set Rng = Cells(Rows.Count, Cell.Column).End(xlUp)
If Rng.Row < Cell.Row Then Exit Sub Else Set Rng = Range(Cell, Rng)

For Each Cell In Rng
Path = Cell
Path = IIf(Right(Cell, 1) <> "\", Path & "\", Path)

With Cell.Offset(0, 1).Hyperlinks(1)
LinkName = Path & .TextToDisplay & ".url"
URL = .Address
End With

With Wsh.CreateShortcut(LinkName)
.TargetPath = URL
.Save
End With
Next Cell

End Sub

[Rosanna24]

Hi Leigh,
Thank you so much for this
Rosanna

[Leith Ross]

Hello Roseanna,

You're welcome. I hope this code was close to what you needed. If you have any questions or need help, let me know and I'll do what I can.

[Rosanna24]

Hello Roseanna,

You're welcome. I hope this code was close to what you needed. If you have any questions or need help, let me know and I'll do what I can.

[Rosanna24]

Hello again Leith,
So sorry I got your name wrong ! Opps !
It was funny because it worked for the first one, but then kept getting stuck on .save when it didn’t work and I ran the debug.
It might be that the path/shortcut names didn’t match, but I did check that.
Difficult as well when you don’t really know what you’re doing so youre working backwards, but a good learning curve. I know your code worked so I must be doing domething dumb ��
It’s fun learning though, I’ll keep trying !
Thanks
Rosanna.

[Leith Ross]

Hello Roseanna,

If you post a few samples of your data , how it appears on the worksheet, that would help me.

[Paul_Hossler]

Another approach - makes a subfolder based on Col A and puts link in that folder based on Col B




Option Explicit


Const cTopLevel As String = "C:\Users\Daddy\Desktop\Schools" ' Change as needed, assumed to exist

Sub MakeFolders()
Dim r As Range
Dim i As Long
Dim oShortcut As Object
Dim sSchool As String, sLink As String

Set r = Worksheets("Folders").Cells(1, 1).CurrentRegion

With r
For i = 2 To .Rows.Count

sSchool = .Cells(i, 1).Value
sLink = .Cells(i, 2).Text

ChDir cTopLevel
MkDir sSchool ' assumes does NOT exist
ChDir sSchool

With CreateObject("Wscript.Shell").CreateShortcut(sSchool & ".url")
.TargetPath = sLink
.Save
End With

Next i
End With

ChDir cTopLevel

End Sub

[Rosanna24]

Hi Leith,
Thank you very much your code worked. I needed to be careful of the text in column B, I was putting the whole path again and I think it may have been that. Now I will work through the Macro and try to learn the code and understand what it did. This has saved me so much time. Thank you !
Rosanna

[Rosanna24]

Hi Paul,
Thank you very much for your reply, I got Leith's macro to work by being more careful of what I was putting in Col B. But I will work through your macro and try see who it is different so that I can hopefully start to understand a bit better how to use macros.
Thanks again,
Rosanna

[snb]

Folderpaths in column A
Website hyperlinks in column B


Sub M_snb()
With CreateObject("wscript.shell")
For Each it In Sheet1.Hyperlinks
With .CreateShortcut(it.Range.Offset(, -1) & "\" & it.TextToDisplay & ".url")
.targetpath = it.Address
.Save
End With
Next
End With
End Sub

[Leith Ross]

Hello Roseanna,

You're welcome. This should help you to understand the macro better...



Sub AddShortcuts()


Dim Cell As Range
Dim LinkName As String
Dim Path As Variant
Dim Rng As Range
Dim URL As String
Dim Wsh As Object

' // Add the Windows Script Host library and create an object reference to it.
Set Wsh = CreateObject("Wscript.Shell")

' // Starting cell of the folder paths.
Set Cell = Range("A2")

' // Find the last non empty cell in column "A".
Set Rng = Cells(Rows.Count, Cell.Column).End(xlUp)

' // Exit if there is no data else set Rng to the cells with data.
If Rng.Row < Cell.Row Then Exit Sub Else Set Rng = Range(Cell, Rng)

' // Step through each cell in column "A".
For Each Cell In Rng
' // Folder path is cell's contents.
Path = Cell

' // Add a backslash to the folder path if it is missing.
Path = IIf(Right(Cell, 1) <> "\", Path & "\", Path)

' // Get the hyperlink information of the cell to the right in column "B".
With Cell.Offset(0, 1).Hyperlinks(1)
' // This is the fully qualified folder path and the name of the school
' // (Text to Display or friendly name) with .url extension to identify this as a web site link.
LinkName = Path & .TextToDisplay & ".url"

' // URL = the Website's URL
URL = .Address
End With

' // Create the shortcut to the website and save it in the folder in cell "A".
With Wsh.CreateShortcut(LinkName)
.TargetPath = URL
.Save
End With
Next Cell

End Sub