我有一个与在此看到的其他问题非常相似的问题,但是他们并没有完全回答我的需要,或者当我尝试使用它们时,它导致了我不知道如何解决的错误。 只是5级,我无法发表评论。
在excel中,我有一个文件用于报价单的命名配置文件。
我尝试将答案用于:Create a folder and sub folder in Excel VBA并按照以下说明对其进行了调整,但是到达If Functions.FolderExists(path) Then
时却报错
运行时错误“ 424”:需要对象。
我还需要根据工作表“数据条目”单元格“ C44”和“ C31”创建文件夹名称,然后我需要向其添加在任何单元格中都未引用的子文件夹,包括: 1.客户询价 这将有另一个子文件夹,其名称基于“数据条目”单元格“ C33”
任何帮助将不胜感激。 谢谢
'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
任何帮助,我们将不胜感激。谢谢
答案 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