Question

很抱歉这个愚蠢的问题，但是我看过多个VBA代码，却无法弄清楚如何操纵代码使其达到我的期望。

基本上，我有一个寄存器，可根据需要填写数据。我要做的基本上是选择A列中的单元格，运行一个宏，然后该Macro会在特定位置创建一个文件夹，并将单元格值作为名称。

在此文件夹中，我要另外两个具有特定名称的文件夹。

例如：

A列单元格= Shubhankit
选择单元格并运行宏
该宏将在特定目录中创建一个名为P18-457的文件夹。例如C：\ Users \ johndo \ Desktop \ Quotes（此目录不会更改，因此每次我创建一个文件夹时，它都会在此位置自动创建它而不提示输入位置）
在此文件夹中，我希望每次都创建两个标准文件夹。例如一个称为成本核算，另一种称为成本核算。
创建了按所选单元格命名的主文件夹后，它将自动创建指向电子表格中文件夹的超链接。

任何人都可以帮助处理此请求，如果已经提出请求，我会提前道歉，但是我似乎无法在网络上找到它？

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") & "\Desktop\Quotes\"

        '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

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

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

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") & "\Desktop\Quotes\"

            '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

希望这对您有所帮助。

在Excel中使用宏创建带有子文件夹和超链接的文件夹

1 个答案: