创建文件夹和子文件夹 [英] Create folder and subfolder

问题描述

我有一个包含数百个客户名称和几个商品编号的Excel文件.

我要检查是否存在具有所选客户名称的文件夹，如果缺少该文件夹，请创建一个文件夹.
找到或创建客户文件夹后，检查每个商品编号是否存在一个文件夹，如果缺少，则创建一个.

我发现代码似乎可以完成所有工作，而且斯科特·霍尔茨曼(Scott Holtzman)还发布了更多代码.

我已将Microsoft脚本运行时作为代码请求.
两者的如果不是"语句标记为红色，弹出窗口仅显示"Compile error".

我检查了"If not"的语法.陈述，这似乎是正确的.

 '需要对Microsoft脚本运行时的引用子MakeFolder()昏暗的strComp作为字符串，strPart作为字符串，strPath作为字符串strComp = Range("A1")'假定公司名称为A1strPart = CleanName(Range("C1"))'假定为C1的一部分strPath =" C:\ Images \"如果不存在FolderExists(strPath& strComp)，则'公司不存在，因此请创建完整路径文件夹创建strPath&strComp&"\"&零件别的'公司确实存在，但零件文件夹确实存在如果不是FolderExists(strPath& strComp&"\"& strPart)，则文件夹创建strPath&strComp&"\"&零件万一万一结束子函数FolderCreate(ByVal path as String)As BooleanFolderCreate = True昏暗的fso作为新的FileSystemObject如果Functions.FolderExists(path)然后退出功能别的出错时转到DeadInTheWaterfso.CreateFolder path'可能有任何错误，例如该路径是否确实弄错了?退出功能万一死在水中:MsgBox无法为以下路径创建文件夹:"&路径和".检查路径名称，然后重试.FolderCreate = False退出功能结束功能函数FolderExists(ByVal路径为字符串)为布尔值FolderExists = False昏暗的fso作为新的FileSystemObject如果fso.FolderExists(path)然后FolderExists = True结束功能函数CleanName(strName as String)as String'将清除部件号名称，以便可以将其制成有效的文件夹名称'可能需要添加更多行以摆脱其他字符CleanName = Replace(strName，"/"，")CleanName =替换(CleanName，"*"，")'    等等...结束功能 

解决方案

看看下面的示例，它显示了使用递归子调用的一种可能方法:

  Option Explicit子TestArrays()昏暗的顾客暗淡的文章昏暗的客户点心昏暗的路径sPath ="C:\ Test"aCustomers = Array("Customer01"，"Customer02"，"Customer03"，"Customer04"，"Customer05")aArticles = Array("Article01"，"Article02"，"Article03"，"Article04"，"Article05")对于客户中的每个客户对于文章中的每一条SmartCreateFolder路径和"\"&客户与"\"&文章下一个下一个结束子子TestFromSheet()昏暗的顾客暗淡的文章昏暗的我昏暗的昏暗的路径sPath ="C:\ Test"With ThisWorkbook.Sheets(1)aCustomers = .Range(.Range("A1")，.Range("A1").End(xlDown)).ValueaArticles = .Range("B1:B10").Value结束于对于i = LBound(aCustomers，1)到UBound(aCustomers，1)对于j = LBound(aArticles，1)到UBound(aArticles，1)SmartCreateFolder路径和"\"&aCustomers(i，1)&"\"&aArticles(j，1)下一个下一个结束子子SmartCreateFolder(sFolder)静态oFSO作为对象如果没有oFSO，则设置oFSO = CreateObject("Scripting.FileSystemObject")使用oFSO如果不是.FolderExists(sFolder)然后SmartCreateFolder .GetParentFolderName(sFolder).CreateFolder sFolder万一结束于结束子 

Sub TestArrays()检查并为硬编码数组中的客户和文章创建文件夹，而 Sub TestFromSheet()从第一个工作表中获取客户和文章，作为示例客户的范围是从A1到最后一个元素，因此那里应该有多个元素，并且商品设置为固定范围B1:B10，如下所示:

I have an Excel file with hundreds of Customer names and several article numbers.

I want to check if a folder with selected customer name exists and create a folder if it is missing.
Once the customer folder is found or created, check if there is a folder for each article number and if it is missing, create one.

I found code that seems to do all that and more posted by Scott Holtzman.

I have referenced Microsoft Scripting Runtime as the code requests.
Both of the "If not" statements are marked red and the pop-up window only says "Compile error".

I checked the syntax of "If not" statements and it seems to be correct.

'requires reference to Microsoft Scripting Runtime
Sub MakeFolder()
    
    Dim strComp As String, strPart As String, strPath As String
    
    strComp = Range("A1") ' assumes company name in A1
    strPart = CleanName(Range("C1")) ' assumes part in C1
    strPath = "C:\Images\"
    
    If Not FolderExists(strPath & strComp) Then 
        'company doesn't exist, so create full path
        FolderCreate strPath & strComp & "\" & strPart
    Else
        'company does exist, but does part folder
        If Not FolderExists(strPath & strComp & "\" & strPart) Then
            FolderCreate strPath & strComp & "\" & strPart
        End If
    End If
    
End Sub
    
Function FolderCreate(ByVal path As String) As Boolean
    
    FolderCreate = True
    Dim fso As New FileSystemObject
    
    If Functions.FolderExists(path) Then
        Exit Function
    Else
        On Error GoTo DeadInTheWater
        fso.CreateFolder path ' could there be any error with this, like if the path is really screwed up?
        Exit Function
    End If
    
DeadInTheWater:
    MsgBox "A folder could not be created for the following path: " & path & ". Check the path name and try again."
    FolderCreate = False
    Exit Function
    
End Function
    
Function FolderExists(ByVal path As String) As Boolean
    
    FolderExists = False
    Dim fso As New FileSystemObject
    
    If fso.FolderExists(path) Then FolderExists = True
    
End Function
    
Function CleanName(strName as String) as String
    'will clean part # name so it can be made into valid folder name
    'may need to add more lines to get rid of other characters
    
    CleanName = Replace(strName, "/","")
    CleanName = Replace(CleanName, "*","")
    '    etc...
    
End Function

解决方案

Take a look at the below example, it shows one of the possible approaches using recursive sub call:

Option Explicit

Sub TestArrays()

    Dim aCustomers
    Dim aArticles
    Dim sCustomer
    Dim sArticle
    Dim sPath

    sPath = "C:\Test"
    aCustomers = Array("Customer01", "Customer02", "Customer03", "Customer04", "Customer05")
    aArticles = Array("Article01", "Article02", "Article03", "Article04", "Article05")
    For Each sCustomer In aCustomers
        For Each sArticle In aArticles
            SmartCreateFolder sPath & "\" & sCustomer & "\" & sArticle
        Next
    Next

End Sub

Sub TestFromSheet()

    Dim aCustomers
    Dim aArticles
    Dim i
    Dim j
    Dim sPath

    sPath = "C:\Test"
    With ThisWorkbook.Sheets(1)
        aCustomers = .Range(.Range("A1"), .Range("A1").End(xlDown)).Value
        aArticles = .Range("B1:B10").Value
    End With
    For i = LBound(aCustomers, 1) To UBound(aCustomers, 1)
        For j = LBound(aArticles, 1) To UBound(aArticles, 1)
            SmartCreateFolder sPath & "\" & aCustomers(i, 1) & "\" & aArticles(j, 1)
        Next
    Next

End Sub

Sub SmartCreateFolder(sFolder)

    Static oFSO As Object

    If oFSO Is Nothing Then Set oFSO = CreateObject("Scripting.FileSystemObject")
    With oFSO
        If Not .FolderExists(sFolder) Then
            SmartCreateFolder .GetParentFolderName(sFolder)
            .CreateFolder sFolder
        End If
    End With

End Sub

Sub TestArrays() checks and creates folders for customers and articles from the hardcoded arrays, and Sub TestFromSheet() gets customers and articles from the first worksheet, as an example customers range from A1 up to the last element, so it should be more than one element there, and articles set to fixed range B1:B10, like shown below:

这篇关于创建文件夹和子文件夹的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！