Folder Nanes

  • Thread starter Thread starter GEORGEBEKOS
  • Start date Start date
G

GEORGEBEKOS

IS THERE A WAY TO GET FOLDER NAMES FROM PATH TO EXCEL WITHOUT THE FILE
IN THEM
(ONLY THE FOLDER NAMES
 
George,

Do you mean you want the active workbook folder name in a cell? If so, try
this

=LEFT(CELL("filename",A1),FIND("]",CELL("filename",A1)))

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
If you have Excel 2000 or later

Dim varr as Variant
Dim sStr as String
Dim i as Long

varr = Split(Application.Path,"\")
sStr = ""
for i = 0 to ubound(varr)-1
sStr = sStr & i & ": " & varr(i) & vbNewLine
Next
msgbox sStr
 
I USE THIS

Sub IndexFiles()
With Application.FileSearch
.LookIn = "H:\JAZZ"
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
.Execute
End With
cnt = Application.FileSearch.FoundFiles.Count
For i = 1 To cnt
Rng = "A" & i
Range(Rng).Value = Application.FileSearch.FoundFiles.Item(i)
Next i
End Sub

AND I GET THIS RESULTS

H:\JAZZ\ANTHONY BRAXTON - Seven standards 1985\01 - Jo
Spring.mp3
H:\JAZZ\ANTHONY BRAXTON - Seven standards 1985\02 - Spring I
Here.mp3
H:\JAZZ\ANTHONY BRAXTON - Seven standards 1985\03 - I Remembe
You.mp3
H:\JAZZ\ANTHONY BRAXTON - Seven standards 1985\04 - Touch To M
Head.mp3
H:\JAZZ\ARNETT COBB - Go power go power\01 - When I Grow Too Old T
Dream.mp3
H:\JAZZ\ARNETT COBB - Go power go power\02 - Go Power.mp3
H:\JAZZ\ARNETT COBB - Go power go power\03 - Dutch Kitche
Bounce.mp3
H:\JAZZ\ARNETT COBB - Go power go power\04 - Go Red, Go.mp3

THIS IS A PART ONLY

AS YOU SEE I TAKE ALL THE SONG FROM FOLDER ,BUT I WANT ONLY FOLDER NAM
(AND SIZE IF POSSIBLE
 
Use the example for the Dir command: (modified to perform what your code
does)

' Display the names in H:\JAZZ that represent directories.
MyPath = "H:\JAZZ" ' Set the path.
MyName = Dir(MyPath, vbDirectory) ' Retrieve the first entry.
i = 0
Do While MyName <> "" ' Start the loop.
' Ignore the current directory and the encompassing directory.
If MyName <> "." And MyName <> ".." Then
' Use bitwise comparison to make sure MyName is a directory.

If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
i = i + 1
cells(i,1).Value = MyName ' Display entry only if it
End If ' it represents a directory.
End If
MyName = Dir ' Get next entry.
Loop

Assumes you only want first level directories.

What do you mean by size - in kb sum of all the file sizes?
 
George,

This seems to be what you are asking for, but it will repeat the folder name
for each file! It also needs XL2000 or above as it uses InstrRev

Sub IndexFiles()
Dim i As Long
With Application.FileSearch
.LookIn = "H:\JAZZ"
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
.Execute
For i = 1 To .FoundFiles.Count
Range("A" & i).Value = Left(.FoundFiles.Item(i),
InStrRev(.FoundFiles.Item(i), "\") - 1)
Next i
End With
End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Change
MyPath = "H:\JAZZ" ' Set the path.

to

MyPath = "H:\JAZZ\" ' Set the path.

with a \ no the end.
Here is as tested version:

Sub AAAListdir()
Dim myPath As String
Dim myName As String
Dim i As Long
' Display the names in H:\JAZZ that represent directories.
myPath = "H:\JAZZ\" ' Set the path.
myName = Dir(myPath, vbDirectory) ' Retrieve the first entry.
i = 0
Do While myName <> "" ' Start the loop.
' Ignore the current directory and the encompassing directory.
If myName <> "." And myName <> ".." Then
' Use bitwise comparison to make sure MyName is a directory.

If (GetAttr(myPath & myName) And vbDirectory) = vbDirectory Then
i = i + 1
Cells(i, 1).Value = myName ' Display entry only if it
End If ' it represents a directory.
End If
myName = Dir ' Get next entry.
Loop

End Sub

--
Regards,
Tom Ogilvy

Tom Ogilvy said:
Use the example for the Dir command: (modified to perform what your code
does)

' Display the names in H:\JAZZ that represent directories.
MyPath = "H:\JAZZ" ' Set the path.
MyName = Dir(MyPath, vbDirectory) ' Retrieve the first entry.
i = 0
Do While MyName <> "" ' Start the loop.
' Ignore the current directory and the encompassing directory.
If MyName <> "." And MyName <> ".." Then
' Use bitwise comparison to make sure MyName is a directory.

If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
i = i + 1
cells(i,1).Value = MyName ' Display entry only if it
End If ' it represents a directory.
End If
MyName = Dir ' Get next entry.
Loop

Assumes you only want first level directories.

What do you mean by size - in kb sum of all the file sizes?
Click to expand...
 
TOM
i use that you sent but it scan only first level folders
can you fix it to scan at second level folders
about the size
i want the size of each folder at kb
 
Sub Tester2()
Dim rw As Long
Dim ilevel As Long
Dim sPath As String
Dim Drive As String
Dim AnyName As String
Dim Volume As String
Dim i As Integer
Dim tot As Long
Dim sName1 As String

Drive = "H:\JAZZ\"
If Trim(Drive) = "" Then Exit Sub
If Right(Drive, 1) <> "\" Then
Drive = Drive & "\"
End If
Dim sArr() As String
ReDim sArr(1 To 1)
rw = 1
ilevel = 1
'Cells(rw, ilevel) = Dir(Drive, vbVolume)
'rw = rw + 1
'Cells(rw, ilevel) = "\"
'rw = rw + 1
AnyName = Dir(Drive, vbDirectory)
Do While AnyName <> ""
If AnyName <> "." And AnyName <> ".." _
And GetAttr(Drive & AnyName) = vbDirectory Then
sArr(UBound(sArr)) = AnyName
ReDim Preserve sArr(1 To UBound(sArr) + 1)
End If
AnyName = Dir()
Loop
ilevel = ilevel + 1
For i = 1 To UBound(sArr) - 1
AnyName = sArr(i)
sPath = Drive & AnyName & "\"
Cells(rw, ilevel) = AnyName
sName1 = Dir(sPath, vbNormal)
tot = 0
Do While sName1 <> ""
tot = tot + FileLen(sPath & sName1)
sName1 = Dir()
Loop
Cells(rw, ilevel + 1) = tot
rw = rw + 1
sPath = Drive & AnyName & "\"
GetSubs sPath, rw, ilevel + 1
Next


End Sub


Sub GetSubs(sPath As String, _
rw As Long, ilevel As Long)
Dim sName As String
Dim sName1 As String
Dim i As Long
Dim sArr()
Dim sPath1 As String
Dim tot As Long
Dim rw1 As Long
ReDim sArr(1 To 1)
sName = Dir(sPath, vbDirectory)
Do While sName <> ""
If sName <> "." And sName <> ".." Then
If GetAttr(sPath & sName) = vbDirectory Then
sArr(UBound(sArr)) = sName
ReDim Preserve sArr(1 To UBound(sArr) + 1)
End If
End If
sName = Dir()
Loop
For i = 1 To UBound(sArr) - 1
sName = sArr(i)
rw1 = rw
sPath1 = sPath & sName & "\"
Cells(rw, ilevel) = sName
sName1 = Dir(sPath1, vbNormal)
tot = 0
Do While sName1 <> ""
tot = tot + FileLen(sPath1 & sName1)
sName1 = Dir()
Loop
Cells(rw, ilevel + 1) = tot
rw = rw + 1
GetSubs sPath & sName & "\", rw, ilevel + 1
Next i

End Sub
 
NOTHING HAPPENS TOM WITH THE ONE YOU SENT
I WILL EXPLAIN ONE MORE TIME
I WANT TO SCAN FIRST SECOND OR THIRD LEVEL
FOLDERS SO THAT I CAN TRANSFER THE NAME( OF THE FOLDERS
ONLY )TO EXCEL
IF IT IS POSSIBLE I WANT TO TRANSFER ANDTHE SIZE OF EACH FOLDER
I WANT TO THANK YOU FOR EVERY WORK YOU DO
SO AND THE OTHER
 
Sub IndexFiles()
With Application.FileSearch
.LookIn = "H:\JAZZ"
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
.Execute
End With
cnt = Application.FileSearch.FoundFiles.Count
For i = 1 To cnt
Rng = "A" & i
Range(Rng).Value = Application.FileSearch.FoundFiles.Item(i)
Next i
End Sub

CAN I USE TIS MODULE TO SCAN
(.m3u FILES)
if i can how;
i use in file type = "*.m3u"
but i get an error
type mismatch
run time error 1
 
nothing tom
take a look at this

Sub INDEX()

With Application.FileSearch

.NewSearch
.LookIn = "H:\JAZZ"
.Filename = "*.m3u"
.Execute
End With
cnt = Application.FileSearch.FoundFiles.Count
For i = 1 To cnt
Rng = "A" & i
Range(Rng).Value = Application.FileSearch.FoundFiles.Item(i)
Next i
End Sub


WITH THIS I CAN GET ALL FOLDER NAMES IF I HAVE
A WINAMP S PLAYLIST IN EVERY FOLDER (m3u)

is there a way to browse for (lookin) to scan like i do in window
explorer so i dont have to write the path lookin every time


i found this but i can t combine with my code
check this is what i want
but i cant combine with my code



Private Type BROWSEINFO ' used by the function GetFolderName
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath A
String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetFolderName(Msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BROWSEINFO, path As String, r As Long
Dim X As Long, pos As Integer
bInfo.pidlRoot = 0& ' Root folder = Desktop
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
' the dialog title
Else
bInfo.lpszTitle = Msg ' the dialog title
End If
bInfo.ulFlags = &H1 ' Type of directory to return
X = SHBrowseForFolder(bInfo) ' display the dialog
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetFolderName = Left(path, pos - 1)
Else
GetFolderName = ""
End If
End Function


Sub TestGetFolderName()
Dim FolderName As String
FolderName = GetFolderName("Select a folder")
If FolderName = "" Then
MsgBox "You didn't select a folder."
Else
MsgBox "You selected this folder: " & FolderName
End If
End Su
 
George,

Have you tried Tom's suggestion. I just tried it and it does what you seem
to be asking for.

Your code is never properly dot qualified.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Well, that isn't what you originally asked for -

Private Type BROWSEINFO ' used by the function GetFolderName
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo _
As BROWSEINFO) As Long

Function GetFolderName(Msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BROWSEINFO, path As String, r As Long
Dim X As Long, pos As Integer
bInfo.pidlRoot = 0& ' Root folder = Desktop
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
' the dialog title
Else
bInfo.lpszTitle = Msg ' the dialog title
End If
bInfo.ulFlags = &H1 ' Type of directory to return
X = SHBrowseForFolder(bInfo) ' display the dialog
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetFolderName = Left(path, pos - 1)
Else
GetFolderName = ""
End If
End Function


Sub TestGetFolderName()
Dim FolderName As String
FolderName = GetFolderName("Select a folder")
If FolderName = "" Then
MsgBox "You didn't select a folder."
Else
With Application.FileSearch
.NewSearch
.LookIn = FolderName
.SearchSubFolders = True
.FileName = ".m3u"
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
cnt = .FoundFiles.Count
For i = 1 To cnt
Rng = "A" & i
Range(Rng).Value = Application. _
FileSearch.FoundFiles.Item(i)
Next i
Else
MsgBox "There were no files found."
End If
End With
End If
End Sub
 
THANK S VERY VERY VERY MUCH
YOU ARE GREAT
I MAY NEED YOU ONE MORE TIME
I HAVE SOMETHING IN MIND
(I WANT TO ADD SOME DETAILS THAT I CAN VIEW) BUT I
DONT WANT TO
BOTHER YOU ALL THE TIME

I WILL SEARCH THE INTERNET
READ ONE BOOK THAT I JUST GET FOR VB
AND I WILL TRY(THATS THE WAY THAT I CAN LEARN)

THERE IS NO WAY TO DESCRIVE YOU HOW MUCH YOU HELP ME
AND HOW MANY THANK YOU DESERVE
 
tom i want something last
can you make this to code to scan the folder from
every m3u so i can get the size of the folder
i will give you an example so i can be more specific

this is what i get from the code that you send me


H:\JAZZ\Dizzy Gillespie\Dizzy Gillepsie - Cuban Jazz Moods\(Dizz
Gillespie) Afro Cuban Jazz Moods.m3u
H:\JAZZ\Miles Davis\Miles Davis - Blue Moods\(Miles Davis) Blu
Moods.m3u
...................................................................................................

and more

i now want to have this look


H:\JAZZ\Dizzy Gillespie\Dizzy Gillepsie - Cuban Jazz Moods\(Dizz
Gillespie) Afro Cuban Jazz Moods.m3u\ 26.800 kb or 26 mb
H:\JAZZ\Miles Davis\Miles Davis - Blue Moods\(Miles Davis) Blu
Moods.m3u\ 67.000 kb or 67 mb

the kbs or mb should be the summary of of all files in the folder
that contain the .m3u file

this is the code that you post


Private Type BROWSEINFO ' used by the function GetFolderName
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo _
As BROWSEINFO) As Long

Function GetFolderName(Msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BROWSEINFO, path As String, r As Long
Dim X As Long, pos As Integer
bInfo.pidlRoot = 0& ' Root folder = Desktop
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
' the dialog title
Else
bInfo.lpszTitle = Msg ' the dialog title
End If
bInfo.ulFlags = &H1 ' Type of directory to return
X = SHBrowseForFolder(bInfo) ' display the dialog
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetFolderName = Left(path, pos - 1)
Else
GetFolderName = ""
End If
End Function


Sub TestGetFolderName()
Dim FolderName As String
FolderName = GetFolderName("Select a folder")
If FolderName = "" Then
MsgBox "You didn't select a folder."
Else
With Application.FileSearch
.NewSearch
.LookIn = FolderName
.SearchSubFolders = True
.FileName = ".m3u"
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
cnt = .FoundFiles.Count
For i = 1 To cnt
Rng = "A" & i
Range(Rng).Value = Application. _
FileSearch.FoundFiles.Item(i)
Next i
Else
MsgBox "There were no files found."
End If
End With
End If
End Sub


thank you i will pe obliged if you do tha
 
Back
Top