用单元格创建文件夹

Question

当我使用以下代码创建一个项目编号时，我需要创建一个标题的文件夹作为以下路径中的新项目编号：W:My systemmemy workPROJECTSProjectsReliability，我知道代码需要为在以下代码完成后，将(.Cells(MyRow, "Q").Value = Sheets("Tracker").Cells(3, "E").Value 'project NUMBER(作为新项目的标题放置在"活动列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

在评论中提到的两个版本上扩展。更新ActivesHeet，并使用正确的单元格进行正确的范围，从而从中收集文件夹名称。当前有默认的 "Testing"名称在情况单元格中创建的名称是空的。

获取名称。

1(MKDIR

Option Explicit
Public Sub MyFileprojectTF()
    Dim startPath As String
    Dim myName As String
    startPath = "W:My systemmemy workPROJECTSProjectsReliability"
    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 systemmemy workPROJECTSProjectsReliability"
    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

Answer 2

使用 MkDir 使用VBA创建一个文件夹：

MkDir "FolderName" 

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

MkDir "c:usersbobdesktopFolderName"

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

创建文件夹W:My systemmemy workPROJECTSProjectsReliability，使用：

MkDir "W:My systemmemy workPROJECTSProjectsReliability"

这里的更多信息(但没有更多要说的(。