有没有办法在Excel VBA中创建文件夹和子文件夹？ [英] Is there a way to create a folder, and sub folders in Excel VBA?

问题描述

好的，对于那些在Excel VBA中是主人的知道，我有一个下拉菜单的公司，由另一个选项卡上的列表填充。三列，公司，工作编号和部件号。

我所做的是当创建作业时，我需要一个创建该公司的文件夹，然后创建一个基于所述部分的子文件夹数。所以如果你沿着这条路走下去，那就像这样：

C：\Images\Company Name\Part Number \\ / code>

现在，如果存在任一公司名称或部件号，则不会创建或覆盖旧的。只是去下一步。所以如果两个文件夹都没有发生任何事情，如果一个或两个文件不存在根据需要创建。

这是否有意义？

如果有人可以帮助我理解这是如何工作的，以及如何使其工作，将不胜感激。再次感谢

另外一个问题，如果不是太多，有没有办法让它在Mac和PC上工作一样？

解决方案

一个子功能和两个功能。 sub构建您的路径并使用函数来检查路径是否存在，如果不存在则创建。如果完整的路径已经存在，它将会传递。
这可以在PC上工作，但是您必须检查需要修改的内容，以便在Mac上工作。

 '需要参考Microsoft Scripting Runtime 
 Sub MakeFolder（）
 
 Dim strComp As String，strPart As String，strPath As String 
 
 strComp = Range（ A1）'假定公司名称为A1 
 strPart = CleanName（Range（C1））'承担C1 
 strPath =C：\Images\
 
如果不是FolderExists（strPath& strComp）然后
'公司不存在，所以创建完整路径
 FolderCreate strPath& strComp& \& strPart 
 Else 
'公司确实存在，但是部分文件夹
如果没有FolderExists（strPath& strComp&\& strPart）然后
 FolderCreate strPath& strComp& \& strPart 
 End If 
 End If 
 
 End Sub 
 
函数FolderCreate（ByVal path As String）As Boolean 
 
 FolderCreate = True 
 Dim fso As New FileSystemObject 
 
如果Functions.FolderExists（path）然后
退出函数
 Else 
错误GoTo DeadInTheWater 
 fso.CreateFolder路径可能会有任何错误，就像路径真的搞砸了吗？ 
退出函数
结束如果
 
 DeadInTheWater：
 MsgBox无法为以下路径创建文件夹：&路径& 检查路径名称，然后再试一次。 
 FolderCreate = False 
退出函数
 
结束函数
 
函数FolderExists（ByVal path As String）As Boolean 
 
 FolderExists = False 
 Dim fso As New FileSystemObject 
 
如果fso.FolderExists（path）Then FolderExists = True 
 
结束函数
 
函数CleanName （strName as String）as String 
'将清理部分＃名称，以便可以将其设置为有效的文件夹名称
'可能需要添加更多行以摆脱其他字符
 
 CleanName =替换（strName，/，）
 CleanName =替换（CleanName，*，）
 etc ... 
 
结束函数
  

Ok, for those in the know that are masters in Excel VBA, I have a pull down menu of companies that is populated by a list on another tab. Three columns, Company, Job #, and Part Number.

What I have going on is that when a job is created I need a folder for said company to be created, and then a sub-folder created based off of said Part Number. So if you go down the path it would look like this:

C:\Images\Company Name\Part Number\

Now if either company name or Part number exists don't create, or overwrite the old one. Just go to next step. So if both folders exist nothing happens, if one or both don't exist create as required.

Does this make sense?

If someone can help me with understanding how this works and how to make it work it would be greatly appreciated. Thanks again.

Another question if it's not too much is there a way to make it so it works on Macs and PCs the same?

解决方案

One sub and two functions. The sub builds your path and use the functions to check if the path exists and create if not. If the full path exists already, it will just pass on by. This will work on PC, but you will have to check what needs to be modified to work on Mac as well.

'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

这篇关于有没有办法在Excel VBA中创建文件夹和子文件夹？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！