有没有办法在Excel VBA中创建文件夹和子文件夹？

Question

好的,对于那些知道Excel VBA主人的人来说,我有一个公司的下拉菜单,由另一个选项卡上的列表填充.三列,公司,工作号和部件号.

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

__CODE__

现在,如果存在公司名称或部件号,则不创建或覆盖旧的名称.转到下一步.因此,如果两个文件夹都不存在,则如果一个或两个不存在则按要求创建.

这有意义吗？

如果有人可以帮助我了解它的工作原理以及如何使其工作,我们将不胜感激.再次感谢.

另一个问题,如果不是太多,有没有办法让它在Mac和PC上运行相同？

Answer 1

另一个在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

Answer 2

一个子功能和两个功能.sub构建路径并使用函数检查路径是否存在,如果不存在则创建.如果已存在完整路径,则它将仅传递.这将适用于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

Answer 3

我找到了一种更好的方法来做同样的事情,更少的代码,更有效率.请注意,""""是引用路径,以防它在文件夹名称中包含空格.如有必要,命令行mkdir将创建任何中间文件夹以使整个路径存在.

If Dir(YourPath, vbDirectory) = "" Then
    Shell ("cmd /c mkdir """ & YourPath & """")
End If

Answer 4

Private Sub CommandButton1_Click()
    Dim fso As Object
    Dim tdate As Date
    Dim fldrname As String
    Dim fldrpath As String

    tdate = Now()
    Set fso = CreateObject("scripting.filesystemobject")
    fldrname = Format(tdate, "dd-mm-yyyy")
    fldrpath = "C:\Users\username\Desktop\FSO\" & fldrname
    If Not fso.folderexists(fldrpath) Then
        fso.createfolder (fldrpath)
    End If
End Sub