Excel - 創建多個文件夾和超鏈接

Question

我想/需要選擇Excel工作表上的單元格並創建文件夾（稱爲與單元格文本相同），並將單元格超鏈接到新創建的文件夾。

我已經設法找到一個VBA，爲選定的單元格創建文件夾，並且它們與excel保存在同一位置保存....非常節省我的時間！

....但我想添加到VBA單元格應該鏈接到創建的文件夾，任何人都可以幫忙嗎？這是爲了節省我超鏈接每個單獨的單元格。

我希望我知道如何創建這些我自己，因爲我很驚訝這看起來像矩陣對我來說！

下面是一個致力於創建文件夾，每個單元的名稱列表中的VBA（我得到這個從論壇）：

Sub MakeFolders() 

    Dim Rng As Range 
    Dim maxRows, maxCols, r, c As Integer 

    Set Rng = Selection 
    maxRows = Rng.Rows.Count 
    maxCols = Rng.Columns.Count 

    For c = 1 To maxCols 

     r = 1 
     Do While r <= maxRows 

      If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c), vbDirectory)) = 0 Then 

       MkDir (ActiveWorkbook.Path & "\" & Rng(r, c)) 
       On Error Resume Next 
      End If 

      r = r + 1 
     Loop 

    Next c 

End Sub 

感謝您的幫助，並請原諒我的知識缺乏關於這個問題。

Answer 1

這應該可以做到。我已經用較短的版本替換了您的MakeFolders過程。

Public Sub MakeHyperlinks() 

    Dim MyRange As Range 
    Dim rCell As Range 

    'List your folders in range A1:A4 - e.g. S:\Bartrup-CookD\Test\My New Folder 1 
    Set MyRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:A4") 

    For Each rCell In MyRange 
     'Create the folder. 
     CreateFolder rCell.Value 

     'Create the hyperlink. 
     rCell.Hyperlinks.Add Anchor:=rCell, _ 
          Address:=Replace(rCell.Value, " ", "%20") 

    Next rCell 

End Sub 

Public Sub CreateFolder(Folder) 
On Error Resume Next 
Dim objFSO As Object: Set objFSO = CreateObject("Scripting.FileSystemObject") 
    If Folder <> "" Then 
     If Not objFSO.FileExists(objFSO.GetParentFolderName(Folder)) Then 
      Call CreateFolder(objFSO.GetParentFolderName(Folder)) 
     End If 
     objFSO.CreateFolder (Folder) 
    End If 
End Sub