excel - 创建文件夹和子文件夹

问题描述

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

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

我发现了 Scott Holtzman 发布的似乎可以完成所有这些工作的代码。

我已将 Microsoft Scripting Runtime 引用为代码请求。
两个“If not”语句都标记为红色，弹出窗口只显示“编译错误”。

我检查了“如果不是”语句的语法，它似乎是正确的。

'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

标签： excelvba

看看下面的例子，它展示了使用递归子调用的可能方法之一：

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()从硬编码的数组中检查并为客户和文章创建文件夹，并Sub TestFromSheet()从第一个工作表中获取客户和文章，例如客户的范围从 A1 到最后一个元素，因此那里应该有多个元素，并且文章设置为固定范围 B1:B10，如下图：

excel - 创建文件夹和子文件夹

问题描述

解决方案

推荐阅读