创建以单元格为名称的文件夹

Question

当我使用以下代码创建项目编号时，我需要在以下路径中创建一个标题为新项目编号的文件夹：W:\My system\me\my work\PROJECTS\Projects\Reliability，我知道代码需要放在后面(.Cells(MyRow, "Q").Value = Sheets("Tracker").Cells(3, "E").Value 'project NUMBER) 作为新项目的标题将在以下代码完成后放置在 "active column 17"

所以我有这段代码检查单元格是否为空，并在提示创建项目编号时，这工作正常但我不确定如何添加代码以在上面的文件夹中创建新文件夹

Sub MyFileprojectTF()
    'Detemine to open or create report.
    'Application.ScreenUpdating = False
    Dim MyNewFile As String
    Dim MySht, MyWBK As String
    Dim MyRow As Integer
    MyRow = ActiveCell.Row
    MySht = ActiveSheet.Name
    MyWBK = ActiveWorkbook.Name

    If ActiveCell.Column = 17 Then
        If ActiveCell.Value <> "" Then 'if cell in the is empty
            MyFileprojectOpenTF
        Else
            OpenTemplate 'opens template tracker for new project number

            With Workbooks("project.xls").Sheets("Tracker")
                .Cells(9, "B").Value = Workbooks(MyWBK).Sheets(MySht).Cells(MyRow, "H").Value  'Project
                .Cells(10, "B").Value = Workbooks(MyWBK).Sheets(MySht).Cells(MyRow, "J").Value  'Customer
                .Cells(2, "G").Value = Workbooks(MyWBK).Sheets(MySht).Cells(MyRow, "P").Value  'tracker
                .Cells(14, "E").Value = Workbooks(MyWBK).Sheets(MySht).Cells(MyRow, "O").Value  'tech
                .Cells(15, "E").Value = Workbooks(MyWBK).Sheets(MySht).Cells(MyRow, "N").Value  'FILE REF
                .Cells(25, "A").Value = Workbooks(MyWBK).Sheets(MySht).Cells(MyRow, "L").Value  'Description
            End With

            '***********************************
            NewProjectGSRTF
            UpDateMyDataBaseTF
            '***********************************

            With Workbooks(MyWBK).Sheets(MySht)
                .Cells(MyRow, "Q").Value = Sheets("Tracker").Cells(3, "E").Value   'project NUMBER
            End With

            ActiveWorkbook.Saved = True
            ActiveWorkbook.Close
            Workbooks(MyWBK).Save
        End If
    End If
    Application.ScreenUpdating = True
End Sub

Answer 1

使用 MkDir 创建文件夹使用 VBA:

MkDir "FolderName"

...在当前目录中创建一个名为“FolderName”的文件夹，或者：

MkDir "c:\users\bob\desktop\FolderName"

...在 Bob 的桌面上创建一个名为“FolderName”的文件夹。

要创建文件夹 W:\My system\me\my work\PROJECTS\Projects\Reliability，请使用：

MkDir "W:\My system\me\my work\PROJECTS\Projects\Reliability"

更多信息here（但没有更多要说的）。

Answer 2

扩展我在评论中提到的两个版本。使用正确的 sheet 更新 Activesheet 并使用正确的单元格更新范围以从中收集文件夹名称。当前已创建默认 "Testing" 名称，以防从中获取名称的单元格为空。

1) MKDIR

Option Explicit

Public Sub MyFileprojectTF()

    Dim startPath As String
    Dim myName As String

    startPath = "W:\My system\me\my work\PROJECTS\Projects\Reliability"
    myName = ActiveSheet.Range("D1").Text        ' Change as required to cell holding the folder title

    If myName = vbNullString Then myName = "Testing"

    Dim folderPathWithName As String
    folderPathWithName = startPath & Application.PathSeparator & myName

    If Dir(folderPathWithName, vbDirectory) = vbNullString Then
        MkDir folderPathWithName
    Else
       MsgBox "Folder already exists"
       Exit Sub
    End If

End Sub

2) FSO

Option Explicit

Public Sub MyFileprojectTF()

    Dim startPath As String
    Dim myName As String

    startPath = "W:\My system\me\my work\PROJECTS\Projects\Reliability"
    myName = ActiveSheet.Range("D1").Text        ' Change as required to cell holding the folder title

    If myName = vbNullString Then myName = "Testing"

    Dim folderPathWithName As String
    folderPathWithName = startPath & Application.PathSeparator & myName

    If Dir(folderPathWithName, vbDirectory) = vbNullString Then
        Dim fso As Object
        Set fso = CreateObject("FileSystemObject")
        fso.CreateFolder folderPathWithName
    Else
       MsgBox "Folder already exists"
       Exit Sub
    End If

End Sub

创建以单元格为名称的文件夹

Creating folder with cell as name

vba

excel

create-directory