Skip to main content
Support is Offline
Today is our off day. We are taking some rest and will come back stronger tomorrow
Official support hours
Monday To Friday
From 09:00 To 17:30
  Sunday, 30 August 2020
  1 Replies
  6.7K Visits
0
Votes
Undo
Hi everyone.

I’m looking for an Excel VBA to insert the subfolder name and one folder before that (parent folder) in separate cells such as A1 and A2.
Example:
I have saved Book1.xlsm in the following directory:
C:\Users\Matthew\Downloads\F23343\29035020\ Book1.xlsm
So, I need the VBA code to insert 29035020 and F23343 names into two separate cells. Also, for the F23343, is there any way to exclude the
letter F and only insert 23343?

Your help is highly appreciated.
Thanks
3 years ago
·
#2181
0
Votes
Undo
Try this :-
'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
  • Page :
  • 1
There are no replies made for this post yet.