get folder parent path and subfolder path in array

R

roykana

Active Member
Joined
Mar 8, 2018
Messages
311
Office Version
  1. 2010
Platform
  1. Windows
Dear All master,
I want to get the path of the parent folder as in column F and the path of the subfolder as in column G which I marked in yellow. I want to just add a little in the code below and don't want to change the structure of the code below


Book3
ABCDEFG
1PATHFILENAMEKODEITEMVPARENTFOLDERPATHSUBFOLDERPATH
2\\server-pc\catalog\catalog\ARTIKEL ACAK TAMIKO\111138(1).jpg111138(1).jpg111138\\server-pc\catalog\catalog\ARTIKEL ACAK TAMIKO\
3\\server-pc\catalog\catalog\111139(1).jpg111139(1).jpg111139\\server-pc\catalog\catalog
4\\server-pc\catalog\catalog\catalog_H-Ride\H98601.jpgH98601.jpgH98601\\server-pc\catalog\catalog\catalog_H-Ride\
5\\server-pc\catalog\catalog\catalog_KaryaAsiaJaya\K102016.jpgK102016.jpgK102016\\server-pc\catalog\catalog\catalog_KaryaAsiaJaya\
6\\server-pc\catalog\catalog\KOSWARA-NO BRAND\04000.jpg04000.jpg04000\\server-pc\catalog\catalog\KOSWARA-NO BRAND\
7\\server-pc\catalog\catalog\OTHERS\0119.jpg0119.jpg0119\\server-pc\catalog\catalog\OTHERS\
8\\server-pc\catalog\catalog\OTHERS\new\1023.. ..jpg1023.. ..jpg1023.. .\\server-pc\catalog\catalog\OTHERS\new\
9\\server-pc\catalog\catalog\OTHERS\new\R67.jpgR67.jpgR67\\server-pc\catalog\catalog\OTHERS\new\
Master


thanks
roykana

VBA Code: 
Sub GetFileName2()

    Dim lr As Long
    Dim rng As Range
    Dim arr1() As String
    Dim arr2() As String
    Dim arr3() As String

    Application.ScreenUpdating = False

'   Find last row in column A with data
    Sheets("Master").Select
    lr = Cells(Rows.Count, "A").End(xlUp).Row
   
'   Pre-format column C for text
    Columns("C:C").NumberFormat = "@"

'   Loop through every cell in column A starting in row 2
    For Each rng In Range("A2:A" & lr)
        arr1 = Split(rng.Value, "\")
        rng.Offset(0, 1).Value = arr1(UBound(arr1, 1))
        arr2 = Split(arr1(UBound(arr1, 1)), "(")
        arr3 = Split(arr2(0), "-")
'       If first member of array is blank, choose the second
        If Left(arr2(0), 1) = "-" Then
            rng.Offset(0, 2).Value = Replace(arr2(0), ".jpg", "")
        Else
            rng.Offset(0, 2).Value = Replace(arr3(0), ".jpg", "")
        End If
    Next rng

    Application.ScreenUpdating = True

End Sub
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Sort by date Sort by votes
Have a try with these few changes:
VBA Code: 
Option Explicit
Sub GetFileName2()
    Dim lr     As Long
    Dim rng    As Range
    Dim arr1() As String
    Dim arr2() As String
    Dim arr3() As String
    Dim I      As Long                            '<- added
    Application.ScreenUpdating = False
    'Find last row in column A with data
    Sheets("Master").Select
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    'Pre-format column C for text
    Columns("C:C").NumberFormat = "@"
    'Loop through every cell in column A starting in row 2
    For Each rng In Range("A2:A" & lr)
        arr1 = Split(rng.Value, "\")
        rng.Offset(0, 1).Value = arr1(UBound(arr1, 1))
        arr2 = Split(arr1(UBound(arr1, 1)), "(")
        arr3 = Split(arr2(0), "-")
        'If first member of array is blank, choose the second
        If Left(arr2(0), 1) = "-" Then
            rng.Offset(0, 2).Value = Replace(arr2(0), ".jpg", "")
        Else
            rng.Offset(0, 2).Value = Replace(arr3(0), ".jpg", "")
        End If
        '------------- added ----------------------------------------------
        'Rebuild array substrings
        For I = 0 To 4
            rng.Offset(0, 5).Value = rng.Offset(0, 5).Value & arr1(I) & "\"
        Next I
        'rng.Offset(0, 5).Value = Left(rng.Value, 28) 'use instead of above For/Next if PARENTFOLDERPATH is always the same with fixed lenght
        For I = 5 To UBound(arr1) - 1
            rng.Offset(0, 6).Value = rng.Offset(0, 6).Value & arr1(I) & "\"
        Next I
        '------------------------------------------------------------------
    Next rng
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Even better (a path separator was missing):
VBA Code: 
'------------- added ----------------------------------------------
'Rebuild array substrings
For I = 0 To 4
    rng.Offset(0, 5).Value = rng.Offset(0, 5).Value & arr1(I) & "\"
Next I
'rng.Offset(0, 5).Value = Left(rng.Value, 28) 'use instead of above For/Next if PARENTFOLDERPATH has always the same fixed lenght
For I = 5 To UBound(arr1) - 1
    If I = 5 Then rng.Offset(0, 6).Value = "\" & rng.Offset(0, 6).Value '<- new
    rng.Offset(0, 6).Value = rng.Offset(0, 6).Value & arr1(I) & "\"
Next I
'------------------------------------------------------------------
 
Upvote 0
rollis13 said:
VBA Code: 
For I = 0 To 4
Click to expand...
Doesn't that pre-suppose the number of folders in the parent folder path, rather than work it out from the data? For example if cell A3 in the sample data was "\\server-pc\catalog\111139(1).jpg" then wouldn't the parent path be only "\\server-pc\catalog"?

This is my attempt. Additions/changes highlighted (I hope that I got them all)
One further point: In the sample data, columns F & G combined give the full path to the file - except for row 3. My code puts a "\" in cell G3 so that row also gives the full path when the two columns are combined. I could make an adjustment to the code if you really want/need that cell to be blank in that circumstance.

Rich (BB code): 
Sub GetFileName2a()
    Dim lr As Long
    Dim rng As Range
    Dim arr1() As String
    Dim arr2() As String
    Dim arr3() As String
    Dim s As String
    Dim num As Long

    Application.ScreenUpdating = False

'   Find last row in column A with data
    Sheets("Master").Select
    lr = Cells(Rows.Count, "A").End(xlUp).Row
 
'   Pre-format column C for text
    Columns("C:C").NumberFormat = "@"

'   Loop through every cell in column A starting in row 2
    num = 1000
    For Each rng In Range("A2:A" & lr)
        s = rng.Value
        arr1 = Split(s, "\")
        rng.Offset(0, 1).Value = arr1(UBound(arr1))
        arr2 = Split(arr1(UBound(arr1, 1)), "(")
        arr3 = Split(arr2(0), "-")
'       If first member of array is blank, choose the second
        If Left(arr2(0), 1) = "-" Then
            rng.Offset(0, 2).Value = Replace(arr2(0), ".jpg", "")
        Else
            rng.Offset(0, 2).Value = Replace(arr3(0), ".jpg", "")
        End If
        If UBound(arr1) < num Then num = UBound(arr1)
        rng.Offset(0, 5).Value = Left(s, InStrRev(s, "\"))
    Next rng
    Range("F2:F" & lr).TextToColumns DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(InStr(1, Application.Substitute(s, "\", "#", num), "#") - 1, 1))
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Peter_SSs said:
Doesn't that pre-suppose the number of folders in the parent folder path, rather than work it out from the data? For example if cell A3 in the sample data was "\\server-pc\catalog\111139(1).jpg" then wouldn't the parent path be only "\\server-pc\catalog"?[/CODE]
Click to expand...
Yes, @Peter_SSs, but my thought was that it was so 'pre-supposed' that PARENTFOLDERPATH could have been hard-coded;).
 
Upvote 0
Peter_SSs said:
Doesn't that pre-suppose the number of folders in the parent folder path, rather than work it out from the data? For example if cell A3 in the sample data was "\\server-pc\catalog\111139(1).jpg" then wouldn't the parent path be only "\\server-pc\catalog"?

This is my attempt. Additions/changes highlighted (I hope that I got them all)
One further point: In the sample data, columns F & G combined give the full path to the file - except for row 3. My code puts a "\" in cell G3 so that row also gives the full path when the two columns are combined. I could make an adjustment to the code if you really want/need that cell to be blank in that circumstance.

Rich (BB code): 
Sub GetFileName2a()
    Dim lr As Long
    Dim rng As Range
    Dim arr1() As String
    Dim arr2() As String
    Dim arr3() As String
    Dim s As String
    Dim num As Long

    Application.ScreenUpdating = False

'   Find last row in column A with data
    Sheets("Master").Select
    lr = Cells(Rows.Count, "A").End(xlUp).Row
 
'   Pre-format column C for text
    Columns("C:C").NumberFormat = "@"

'   Loop through every cell in column A starting in row 2
    num = 1000
    For Each rng In Range("A2:A" & lr)
        s = rng.Value
        arr1 = Split(s, "\")
        rng.Offset(0, 1).Value = arr1(UBound(arr1))
        arr2 = Split(arr1(UBound(arr1, 1)), "(")
        arr3 = Split(arr2(0), "-")
'       If first member of array is blank, choose the second
        If Left(arr2(0), 1) = "-" Then
            rng.Offset(0, 2).Value = Replace(arr2(0), ".jpg", "")
        Else
            rng.Offset(0, 2).Value = Replace(arr3(0), ".jpg", "")
        End If
        If UBound(arr1) < num Then num = UBound(arr1)
        rng.Offset(0, 5).Value = Left(s, InStrRev(s, "\"))
    Next rng
    Range("F2:F" & lr).TextToColumns DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(InStr(1, Application.Substitute(s, "\", "#", num), "#") - 1, 1))
    Application.ScreenUpdating = True
End Sub
Click to expand...
@Peter_SSs
Dear Mr. Peter,
Thank you for your reply. Sorry I'm late to reply.


after I try your additional code and add for another path it doesn't match.

Book3
ABCDEFG
1PATHFILENAMEKODEITEMVPARENTFOLDERPATHSUBFOLDERPATH
2\\server-pc\catalog\catalog\ARTIKEL ACAK TAMIKO\111138(1).jpg111138(1).jpg111138\\server-pc\catalog\catalog\ARTIKEL ACAK TAMIKO\
3\\server-pc\catalog\catalog\111139(1).jpg111139(1).jpg111139\\server-pc\catalog\catalog\
4\\server-pc\catalog\catalog\catalog_H-Ride\H98601.jpgH98601.jpgH98601\\server-pc\catalog\catalog\catalog_H-Ride\
5\\server-pc\catalog\catalog\catalog_KaryaAsiaJaya\K102016.jpgK102016.jpgK102016\\server-pc\catalog\catalog\catalog_KaryaAsiaJaya\
6\\server-pc\catalog\catalog\KOSWARA-NO BRAND\04000.jpg04000.jpg04000\\server-pc\catalog\catalog\KOSWARA-NO BRAND\
7\\server-pc\catalog\catalog\OTHERS\0119.jpg0119.jpg0119\\server-pc\catalog\catalog\OTHERS\
8\\server-pc\catalog\catalog\OTHERS\new\1023.. ..jpg1023.. ..jpg1023.. .\\server-pc\catalog\catalog\OTHERS\new\
9\\server-pc\catalog\catalog\OTHERS\new\R67.jpgR67.jpgR67\\server-pc\catalog\catalog\OTHERS\new\
10\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111138(1).jpg111138(1).jpg111138\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
11\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111138(2).jpg111138(2).jpg111138\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
12\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111138(3).jpg111138(3).jpg111138\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
13\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111188(1).jpg111188(1).jpg111188\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
14\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111188(2).jpg111188(2).jpg111188\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
15\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111188(3).jpg111188(3).jpg111188\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
16C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111138(1).jpg111138(1).jpg111138C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
17C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111138(2).jpg111138(2).jpg111138C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
18C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111138(3).jpg111138(3).jpg111138C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
19C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111188(1).jpg111188(1).jpg111188C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
20C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111188(2).jpg111188(2).jpg111188C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
21C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111188(3).jpg111188(3).jpg111188C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
22C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111195(1).jpg111195(1).jpg111195C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
23C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111195(2).jpg111195(2).jpg111195C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
Master


Thanks
roykana
 
Upvote 0
roykana said:
@Peter_SSs
Dear Mr. Peter,
Thank you for your reply. Sorry I'm late to reply.


after I try your additional code and add for another path it doesn't match.

Book3
ABCDEFG
1PATHFILENAMEKODEITEMVPARENTFOLDERPATHSUBFOLDERPATH
2\\server-pc\catalog\catalog\ARTIKEL ACAK TAMIKO\111138(1).jpg111138(1).jpg111138\\server-pc\catalog\catalog\ARTIKEL ACAK TAMIKO\
3\\server-pc\catalog\catalog\111139(1).jpg111139(1).jpg111139\\server-pc\catalog\catalog\
4\\server-pc\catalog\catalog\catalog_H-Ride\H98601.jpgH98601.jpgH98601\\server-pc\catalog\catalog\catalog_H-Ride\
5\\server-pc\catalog\catalog\catalog_KaryaAsiaJaya\K102016.jpgK102016.jpgK102016\\server-pc\catalog\catalog\catalog_KaryaAsiaJaya\
6\\server-pc\catalog\catalog\KOSWARA-NO BRAND\04000.jpg04000.jpg04000\\server-pc\catalog\catalog\KOSWARA-NO BRAND\
7\\server-pc\catalog\catalog\OTHERS\0119.jpg0119.jpg0119\\server-pc\catalog\catalog\OTHERS\
8\\server-pc\catalog\catalog\OTHERS\new\1023.. ..jpg1023.. ..jpg1023.. .\\server-pc\catalog\catalog\OTHERS\new\
9\\server-pc\catalog\catalog\OTHERS\new\R67.jpgR67.jpgR67\\server-pc\catalog\catalog\OTHERS\new\
10\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111138(1).jpg111138(1).jpg111138\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
11\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111138(2).jpg111138(2).jpg111138\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
12\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111138(3).jpg111138(3).jpg111138\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
13\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111188(1).jpg111188(1).jpg111188\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
14\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111188(2).jpg111188(2).jpg111188\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
15\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111188(3).jpg111188(3).jpg111188\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
16C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111138(1).jpg111138(1).jpg111138C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
17C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111138(2).jpg111138(2).jpg111138C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
18C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111138(3).jpg111138(3).jpg111138C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
19C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111188(1).jpg111188(1).jpg111188C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
20C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111188(2).jpg111188(2).jpg111188C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
21C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111188(3).jpg111188(3).jpg111188C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
22C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111195(1).jpg111195(1).jpg111195C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
23C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111195(2).jpg111195(2).jpg111195C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
Master


Thanks
roykana
Click to expand...
@Peter_SSs
desired result

Book3
ABCDEFG
1PATHFILENAMEKODEITEMVPARENTFOLDERPATHSUBFOLDERPATH
2\\server-pc\catalog\catalog\ARTIKEL ACAK TAMIKO\111138(1).jpg111138(1).jpg111138\\server-pc\catalog\catalog\ARTIKEL ACAK TAMIKO\
3\\server-pc\catalog\catalog\111139(1).jpg111139(1).jpg111139\\server-pc\catalog\catalog\
4\\server-pc\catalog\catalog\catalog_H-Ride\H98601.jpgH98601.jpgH98601\\server-pc\catalog\catalog\catalog_H-Ride\
5\\server-pc\catalog\catalog\catalog_KaryaAsiaJaya\K102016.jpgK102016.jpgK102016\\server-pc\catalog\catalog\catalog_KaryaAsiaJaya\
6\\server-pc\catalog\catalog\KOSWARA-NO BRAND\04000.jpg04000.jpg04000\\server-pc\catalog\catalog\KOSWARA-NO BRAND\
7\\server-pc\catalog\catalog\OTHERS\0119.jpg0119.jpg0119\\server-pc\catalog\catalog\OTHERS\
8\\server-pc\catalog\catalog\OTHERS\new\1023.. ..jpg1023.. ..jpg1023.. .\\server-pc\catalog\catalog\OTHERS\new\
9\\server-pc\catalog\catalog\OTHERS\new\R67.jpgR67.jpgR67\\server-pc\catalog\catalog\OTHERS\new\
10\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111138(1).jpg111138(1).jpg111138\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
11\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111138(2).jpg111138(2).jpg111138\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
12\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111138(3).jpg111138(3).jpg111138\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
13\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111188(1).jpg111188(1).jpg111188\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
14\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111188(2).jpg111188(2).jpg111188\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
15\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111188(3).jpg111188(3).jpg111188\\server-pc\catalog\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
16C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111138(1).jpg111138(1).jpg111138C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
17C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111138(2).jpg111138(2).jpg111138C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
18C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111138(3).jpg111138(3).jpg111138C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
19C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111188(1).jpg111188(1).jpg111188C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
20C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111188(2).jpg111188(2).jpg111188C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
21C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111188(3).jpg111188(3).jpg111188C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
22C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111195(1).jpg111195(1).jpg111195C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
23C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\111195(2).jpg111195(2).jpg111195C:\Users\Administrator\Desktop\catalog BAG FINAL\ARTIKEL RANDOM TAMIKA\
Master
 
Upvote 0
Peter_SSs said:
In that case you had better explain how you determine what is a parent folder path and what is not@Peter_
Click to expand...
@Peter_SSs
dear Mr. Peter_SSs
for those that contain the following, this is categorized as "PARENTFOLDERPATH" :
\catalog\catalog
\catalog\catalog BAG FINAL
\Desktop\catalog BAG FINAL
for those that contain the following, this is categorized as "SUBFOLDERPATH" :
\catalog\catalog >> after this, it is categorized as a subfolder path.
\catalog\catalog BAG FINAL >> after this, it is categorized as a subfolder path.
\Desktop\catalog BAG FINAL >> after this, it is categorized as a subfolder path.
in your code later please add a comment if I would like to add another category of content.

Thanks

roykana
 
Upvote 0
See if this does what you want.

VBA Code: 
Sub GetFileName2b()
    Dim lr As Long
    Dim rng As Range
    Dim arr1() As String
    Dim arr2() As String
    Dim arr3() As String
    Dim s As String
    Dim L1 As Long, L2 As Long, L3 As Long, EndPos As Long
    
    'List parent folders
    Const PF1 As String = "\catalog\catalog BAG FINAL\"
    Const PF2 As String = "\Desktop\catalog BAG FINAL\"
    Const PF3 As String = "\catalog\catalog\"
    
    'Parent folder length -2
    L1 = Len(PF1) - 2
    L2 = Len(PF2) - 2
    L3 = Len(PF3) - 2

    Application.ScreenUpdating = False

'   Find last row in column A with data
    Sheets("Master").Select
    lr = Cells(Rows.Count, "A").End(xlUp).Row
 
'   Pre-format column C for text
    Columns("C:C").NumberFormat = "@"

'   Loop through every cell in column A starting in row 2
    For Each rng In Range("A2:A" & lr)
        s = rng.Value
        arr1 = Split(s, "\")
        rng.Offset(0, 1).Value = arr1(UBound(arr1))
        arr2 = Split(arr1(UBound(arr1, 1)), "(")
        arr3 = Split(arr2(0), "-")
'       If first member of array is blank, choose the second
        If Left(arr2(0), 1) = "-" Then
            rng.Offset(0, 2).Value = Replace(arr2(0), ".jpg", "")
        Else
            rng.Offset(0, 2).Value = Replace(arr3(0), ".jpg", "")
        End If
        
        Select Case True
          Case InStr(1, s, PF1, 1) > 0
            EndPos = InStr(1, s, PF1, 1) + L1
          Case InStr(1, s, PF2, 1) > 0
            EndPos = InStr(1, s, PF2, 1) + L2
          Case InStr(1, s, PF3, 1) > 0
            EndPos = InStr(1, s, PF3, 1) + L3
            
          'Add more 'Case' here if there are more parent folders
          
          Case Else
            EndPos = Len(s) - Len(rng.Offset(, 1).Value)
        End Select
        rng.Offset(0, 5).Value = Left(s, EndPos)
        rng.Offset(, 6).Value = Replace(Mid(s, EndPos + 1), rng.Offset(, 1).Value, "", , , 1)
    Next rng
    
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

M
  • Question Question
VBA search for specific file name in folders and their subfolders
Replies
7
Views
4K
Candyman8019
C
M
  • Solved
VBA code to get picture dimensions & DPI from selectable folder and it's subfolders
Replies
8
Views
1K
NdNoviceHlp
NdNoviceHlp
E
  • Question Question
VBA code clean up
Replies
9
Views
593
mumps
mumps
kelly mort
  • Solved
VBA Code To Switch Path Dynamically For Subfolders In A Parent Folder
Replies
3
Views
1K
GWteB
GWteB
K
  • Question Question
Program is slow when working with 4 lakh of data .with multiple workbook
Replies
4
Views
664
Khan kashaf
K

Forum statistics

Threads
1,224,824
Messages
6,181,186
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top