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
 
Sort by date Sort by votes
Peter_SSs said:
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
Click to expand...
@Peter_SSs
Thank you very much for your reply. You're the best
It went perfectly.

thanks
roykana
 
Upvote 0

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
@Peter_SSs
Dear Mr. Peter_SSs,
I need a little help from your code I want results like in column H so the point slash at the beginning and last in column G I want to be removed and result in column H .
thanks
roykana

Book1
ABCDEFGH
1PATHFILENAMEKODEITEMVPARENTFOLDERPATHSUBFOLDERPATHSUBFOLDERPATHCUSTOM
2\\server-pc\catalog\catalog\ARTIKEL ACAK TAMIKO\111138(1).jpg111138(1).jpg111138\\server-pc\catalog\catalog\ARTIKEL ACAK TAMIKO\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\catalog_H-Ride
5\\server-pc\catalog\catalog\catalog_KaryaAsiaJaya\K102016.jpgK102016.jpgK102016\\server-pc\catalog\catalog\catalog_KaryaAsiaJaya\catalog_KaryaAsiaJaya
6\\server-pc\catalog\catalog\KOSWARA-NO BRAND\04000.jpg04000.jpg04000\\server-pc\catalog\catalog\KOSWARA-NO BRAND\KOSWARA-NO BRAND
7\\server-pc\catalog\catalog\OTHERS\0119.jpg0119.jpg0119\\server-pc\catalog\catalog\OTHERS\OTHERS
8\\server-pc\catalog\catalog\OTHERS\new\1023.. ..jpg1023.. ..jpg1023.. .\\server-pc\catalog\catalog\OTHERS\new\OTHERS\new
9\\server-pc\catalog\catalog\OTHERS\new\R67.jpgR67.jpgR67\\server-pc\catalog\catalog\OTHERS\new\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\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\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\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\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\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\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\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\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\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\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\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\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\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\ARTIKEL RANDOM TAMIKA
MASTER
 
Upvote 0
See if making this change does what you want.

Rich (BB code): 
rng.Offset(, 6).Value = Replace(Mid(s, EndPos + 1), rng.Offset(, 1).Value, "", , , 1)
With rng.Offset(, 6)
  .Value = Replace(Mid(s, EndPos + 1), rng.Offset(, 1).Value, "", , , 1)
  If Len(.Value) > 1 Then .Offset(, 1).Value = Mid(.Value, 2, Len(.Value) - 2)
End With
 
Upvote 0
Peter_SSs said:
See if making this change does what you want.

Rich (BB code): 
rng.Offset(, 6).Value = Replace(Mid(s, EndPos + 1), rng.Offset(, 1).Value, "", , , 1)
With rng.Offset(, 6)
  .Value = Replace(Mid(s, EndPos + 1), rng.Offset(, 1).Value, "", , , 1)
  If Len(.Value) > 1 Then .Offset(, 1).Value = Mid(.Value, 2, Len(.Value) - 2)
End With
Click to expand...
@Peter_SSs
Thank you very much for your reply. You're the best
It went perfectly.

thanks
roykana
 
Upvote 0
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,187
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