PDA

View Full Version : [SOLVED:] Get Full File Path


khalid79m
11-05-2008, 04:48 AM
I currently have this macro in place


Dim oFSO As Object
Dim NextRow As Long

Public Sub LoopFolders()
Application.DisplayAlerts = False
Sheets("NonReturnsB1").Delete
Sheets.Add.Name = "NonReturnsB1"
Sheets("NonReturnsB1").Select
Application.DisplayAlerts = True
Set oFSO = CreateObject("Scripting.FileSystemObject")
selectFiles "" & Worksheets("Control_Panel").Range("C14").Value
Set oFSO = Nothing
End Sub

Private Sub selectFiles(sPath)
Dim Folder As Object
Dim Files As Object
Dim file As Object
Dim fldr
Set Folder = oFSO.GetFolder(sPath)
For Each fldr In Folder.SubFolders
selectFiles fldr.Path
Next fldr
For Each file In Folder.Files
If file.Type Like "*Microsoft Excel*" Then
NextRow = NextRow + 1
ActiveSheet.Cells(NextRow, "A").Value = file.Name
End If
Next file
End Sub

However this only returns the file name, I need the entire path ? Can anyone help
Bob Phillips
11-05-2008, 05:28 AM
File.path
khalid79m
11-05-2008, 05:56 AM
im a little confused.. can you elaborate..:dunno
shamsam1
11-05-2008, 06:01 AM
change


activesheet.cells(nextrow,"A").value=file.name


to


activesheet.cells(nextrow,"A").value=file.path
Digita
11-08-2008, 08:04 AM
Hi guys,

I had a run time error # 70 "Permission denied" when running the OP's code with XL 2003 on Vista OS. This code stumbles on line:


For Each fldr In Folder.SubFolders
Something to do with the UAC I guess. After doing some google searches, I exclude certain folders from the operation. The amended loop (below) did not overcome the error. Would anyone have any fix for this?


For Each fldr In Folder.SubFolders
SDir = fldr.Path
If InStr(SDir, "Local Settings") < 1 And Not LCase(SDir) = "c:\windows" And Not LCase(SDir) = "c:\system volume information" Then selectFiles SDir
Next fldr
Thanks in advance.

Regards
Bob Phillips
11-08-2008, 10:08 AM
Maybe this will get you through it



Dim oFSO As Object
Dim NextRow As Long

Public Sub LoopFolders()
Application.DisplayAlerts = False
Sheets("NonReturnsB1").Delete
Sheets.Add.Name = "NonReturnsB1"
Sheets("NonReturnsB1").Select
Application.DisplayAlerts = True
Set oFSO = CreateObject("Scripting.FileSystemObject")
selectFiles "" & Worksheets("Control_Panel").Range("C14").Value
Set oFSO = Nothing
End Sub

Private Sub selectFiles(sPath)
Dim Folder As Object
Dim Files As Object
Dim file As Object
Dim fldr
Set Folder = oFSO.GetFolder(sPath)
On Error GoTo next_action
For Each fldr In Folder.SubFolders
selectFiles fldr.Path
Next fldr
Next Action:
On Error GoTo 0
For Each file In Folder.Files
If file.Type Like "*Microsoft Excel*" Then
NextRow = NextRow + 1
ActiveSheet.Cells(NextRow, "A").Value = file.Name
End If
Next file
End Sub
Digita
11-08-2008, 03:30 PM
Brilliant. Thanks Bob.

Have a great weekend.

Regards


kp
nayone
11-10-2008, 08:54 AM
& formula for the spreadsheet >

=SUBSTITUTE(SUBSTITUTE(LEFT(CELL("filename",A70),FIND("]",CELL("filename",A70))),"[",""),"]","")
khalid79m
11-13-2008, 07:16 AM
thank guys for all your help on this one..