Question

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

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

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"

...创建一个名为＆＃34; FolderName＆＃34;的文件夹。在当前目录中，或：

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

...创建一个名为＆＃34; FolderName＆＃34;的文件夹。在Bob的桌面上。

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

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

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

Answer 2

扩展我在评论中提到的两个版本。使用正确的单元格更新活动表格，并使用正确的单元格从中收集文件夹名称。目前已创建默认"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

使用单元格作为名称创建文件夹

2 个答案: