创建一个包含子文件夹和超链接的文件夹

Question

我想在a列中选择一个单元格，运行宏在特定位置创建一个以单元格值为名称的文件夹。

在这个文件夹中，我想要两个具有特定名称的文件夹。

例如：

1. A列单元格=P18-457
2. 选择单元格并运行宏
3. 该宏将在C:\Users\johndo\Desktop\Quotes中创建一个名为P18-457的文件夹(该目录不会更改，因此每次创建文件夹时都不会提示位置(
4. 在文件夹P18-457中创建两个标准文件夹。例如，一个称为成本计算，另一个参考文献
5. 在电子表格中创建指向文件夹P18-457的超链接

Answer 1

我不明白您要在P18-457文件夹中创建的子文件夹，但P18-457文件夹和超链接的创建可以这样完成。

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim FolderPath As String
On Error GoTo errh:
If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
'Main folder path. - This need to exist already
FolderPath = "C:Users" & Environ("Username") & "DesktopQuotes"
'Make the directory assuming the Quotes folder is already existing
MkDir FolderPath & Target.value
'Make the sub directory Costings
MkDir FolderPath & Target.value & "Costings"
'Make the sub directory Reference
MkDir FolderPath & Target.value & "Reference"
'Create hyperlink
ActiveSheet.Hyperlinks.Add Anchor:=Target, Address:=FolderPath & Target.value
End If
Exit Sub
'error handling
errh:
MsgBox "Error in creating subfolder with hyperlink" & vbCrLf & "Error no. " & Err.Number
End Sub

将其粘贴到您正在处理的工作表中，它应该可以工作。要运行此宏，您需要双击列中的单元格

要运行它，请在手动创建一个命令按钮。将以下代码复制到该命令按钮对象中。

Private Sub CommandButton1_Click()
Dim FolderPath As String
If Not Application.Intersect(ActiveCell, Range("A:A")) Is Nothing Then
If ActiveCell.Hyperlinks.Count = 0 Then
'Main folder path
FolderPath = "C:Users" & Environ("Username") & "DesktopQuotes"
'Make the directory assuming the Quotes folder is already existing
MkDir FolderPath & ActiveCell.value
'Make the sub directory Costings
MkDir FolderPath & ActiveCell.value & "Costings"
'Make the sub directory Reference
MkDir FolderPath & ActiveCell.value & "Reference"
'Create hyperlink
ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell, Address:=FolderPath & ActiveCell.value
End If
End If
End Sub

希望这能帮到你。