Create a folder and sub folder in Excel VBA

后端 未结 13 1614
梦谈多话
梦谈多话 2020-11-28 05:43

I have a pull down menu of companies that is populated by a list on another sheet. Three columns, Company, Job #, and Part Number.

When a job is created I need a fo

13条回答
  •  没有蜡笔的小新
    2020-11-28 06:12

    Never tried with non Windows systems, but here's the one I have in my library, pretty easy to use. No special library reference required.

    Function CreateFolder(ByVal sPath As String) As Boolean
    'by Patrick Honorez - www.idevlop.com
    'create full sPath at once, if required
    'returns False if folder does not exist and could NOT be created, True otherwise
    'sample usage: If CreateFolder("C:\toto\test\test") Then debug.print "OK"
    'updated 20130422 to handle UNC paths correctly ("\\MyServer\MyShare\MyFolder")
    
        Dim fs As Object 
        Dim FolderArray
        Dim Folder As String, i As Integer, sShare As String
    
        If Right(sPath, 1) = "\" Then sPath = Left(sPath, Len(sPath) - 1)
        Set fs = CreateObject("Scripting.FileSystemObject")
        'UNC path ? change 3 "\" into 3 "@"
        If sPath Like "\\*\*" Then
            sPath = Replace(sPath, "\", "@", 1, 3)
        End If
        'now split
        FolderArray = Split(sPath, "\")
        'then set back the @ into \ in item 0 of array
        FolderArray(0) = Replace(FolderArray(0), "@", "\", 1, 3)
        On Error GoTo hell
        'start from root to end, creating what needs to be
        For i = 0 To UBound(FolderArray) Step 1
            Folder = Folder & FolderArray(i) & "\"
            If Not fs.FolderExists(Folder) Then
                fs.CreateFolder (Folder)
            End If
        Next
        CreateFolder = True
    hell:
    End Function
    

提交回复
热议问题