是否有方法在ExcelVBA中创建文件夹和子文件夹?

内容来源于 Stack Overflow,并遵循CC BY-SA 3.0许可协议进行翻译与使用

  • 回答 (2)
  • 关注 (0)
  • 查看 (50)

好的,对于那些知道是ExcelVBA大师的人来说,我有一个公司下拉菜单,该菜单被另一个选项卡上的列表填充。三栏,公司,作业#和零件编号。

我所做的是,当一个工作被创建时,我需要一个文件夹来创建该公司,然后根据所述的部件号创建一个子文件夹。所以如果你沿着这条路走,它会是这样的:

C:\Images\Company Name\Part Number\

这有道理吗?

如果有人能帮助我理解这是如何工作的,如何使它工作,这将是非常感谢的。再次感谢。

另一个问题,如果它不是太多,有没有办法使它的工作在Mac和PC上一样?

提问于
用户回答回答于

两个功能。子构建路径,并使用函数检查路径是否存在,如果不存在,则创建路径。如果完整的路径已经存在,它就会过去。这将在PC上工作,但你必须检查什么需要修改,以便在Mac上工作。

'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
用户回答回答于

另一个在PC上工作的简单版本:

Sub CreateDir(strPath As String)
    Dim elm As Variant
    Dim strCheckPath As String

    strCheckPath = ""
    For Each elm In Split(strPath, "\")
        strCheckPath = strCheckPath & elm & "\"
        If Len(Dir(strCheckPath, vbDirectory)) = 0 Then MkDir strCheckPath
    Next
End Sub

扫码关注云+社区