Excel VBA创建一个文件夹,子文件夹以及其他子文件夹

时间:2020-04-06 12:51:15

标签: excel vba

我有一个与在此看到的其他问题非常相似的问题,但是他们并没有完全回答我的需要,或者当我尝试使用它们时,它导致了我不知道如何解决的错误。 只是5级,我无法发表评论。

在excel中,我有一个文件用于报价单的命名配置文件。

我尝试将答案用于:Create a folder and sub folder in Excel VBA并按照以下说明对其进行了调整,但是到达If Functions.FolderExists(path) Then时却报错

运行时错误“ 424”:需要对象。

我还需要根据工作表“数据条目”单元格“ C44”和“ C31”创建文件夹名称,然后我需要向其添加在任何单元格中都未引用的子文件夹,包括: 1.客户询价 这将有另一个子文件夹,其名称基于“数据条目”单元格“ C33”

  1. 设计工程
  2. 图纸
  3. 化妆品
  4. 时间表
  5. 报价

任何帮助将不胜感激。 谢谢

'requires reference to Microsoft Scripting Runtime
Sub MakeFolder()

Dim strFolder As String, strPath As String

strFolder = CleanName(Range("C31")) ' assumes folder name is in C31
strPath = Range("C44") ' assumes path name is in C44

If Not FolderExists(strPath) Then
'Path doesn't exist, so create full path
    FolderCreate strPath & "\" & strFolder
Else
'Path does exist, but no quote folder
    If Not FolderExists(strPath & "\" & strFolder) Then
        FolderCreate strPath & "\" & strFolder
    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 'This is the part that doesn't work
    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, "*", "")

End Function

任何帮助,我们将不胜感激。谢谢

1 个答案:

答案 0 :(得分:0)

感谢@ BigBen,@ BrianMStafford的帮助。我设法提出了可行的办法。这将在主文件夹中的单元指定位置中创建10个子文件夹。然后,它在文件夹1中创建另一个子文件夹。

由于某种原因,我的公司安全性在打开由代码创建的文件时出现问题,这些文件中的名称不是来自单元格。因此,我计划将所有其他文件夹名称移到一系列单元格,希望它能起作用。

此后,当我确定如何做时,我打算让它打开用户将首先使用的文件夹。就我而言,这是最后创建的文件夹。希望这对某人有帮助:-)

'requires reference to Microsoft Scripting Runtime
Sub MakeFolder()

Dim strFolder As String, strPath As String

strFolder = CleanName(Range("C31")) ' assumes folder name is in C31
strPath = Range("C44") ' assumes path name is in C44

If Not FolderExists(strPath) Then
'Path doesn't exist, so create full path
    FolderCreate strPath & "\" & strFolder
Else
'Path does exist, but no quote folder
    If Not FolderExists(strPath & "\" & strFolder) Then
        FolderCreate strPath & "\" & strFolder
        FolderCreate strPath & "\" & strFolder & "\" & "01. Customer RFQ"
        FolderCreate strPath & "\" & strFolder & "\" & "02. Design Engineering"
        FolderCreate strPath & "\" & strFolder & "\" & "03. Drawings"
        FolderCreate strPath & "\" & strFolder & "\" & "04. Costings"
        FolderCreate strPath & "\" & strFolder & "\" & "05. Schedules"
        FolderCreate strPath & "\" & strFolder & "\" & "06. Quotation"
        FolderCreate strPath & "\" & strFolder & "\" & "07. Email"
        FolderCreate strPath & "\" & strFolder & "\" & "08. MOMs"
        FolderCreate strPath & "\" & strFolder & "\" & "09. Sales Excellence"
        FolderCreate strPath & "\" & strFolder & "\" & "10. Compliance"
        FolderCreate strPath & "\" & strFolder & "\" & "01. Customer RFQ" & "\" & Range("C33")
    End If
End If

End Sub

Function FolderCreate(ByVal path As String) As Boolean

FolderCreate = True
Dim fso As New FileSystemObject

If fso.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, "*", "")

End Function