我有一个公司的下拉菜单,由另一个工作表上的列表填充。三列:公司、职务编号和部件号。
当一个工作是创建的时候,我需要一个文件夹,说公司和子文件夹说,零件编号。
如果你沿着这条路走下去,它看起来会像这样:
C:\图像\公司名称\零件号\
如果公司名称或部件号存在,请不要创建或覆盖旧名称或部件号。只需转到下一步。因此,如果两个文件夹都存在,则不会发生任何事情;如果其中一个或两个文件夹都不存在,则按需创建。
另一个问题是,有没有办法让它在Mac和PC上都能运行?
发布于 2012-05-30 02:43:45
一个子函数和两个函数。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
发布于 2015-11-12 20:23:24
另一个运行在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
发布于 2014-11-15 00:42:46
我发现了一种更好的方法来做同样的事情,代码更少,效率更高。请注意,“用于引用路径,以防文件夹名称中包含空格。如果需要,命令行mkdir会创建任何中间文件夹,以使整个路径存在。
If Dir(YourPath, vbDirectory) = "" Then
Shell ("cmd /c mkdir """ & YourPath & """")
End If
https://stackoverflow.com/questions/10803834
复制相似问题