PDA

View Full Version : Solved: VBA file names (and more) from folder on worksheet



Mario62
08-24-2009, 06:23 AM
Hi,

I'm a newbie... and I need some help.

I'm looking for several days to find a solution. Some are close but not exactely what I am looking for.

I'm using Excel 2007. I have several folder with powerpoint-names. I would love to retrieve all file names (with extension pps and pptx) from a folder on a worksheet. I would love to choose the folder name by clicking in a kind of dialog window. In the column besides the name of the presention i would like to see the full name (including the path), next column the size ans last column the date.

So for example:

Beautiful.pps D:\powerpoint\Beautiful.pps 1,520 7/7/2009

What i found till now - probably on this forum - but i do not know how to adapt it:




Private Sub CommandButton1_Click()

Sheets("powerpoint").Select
wispowerpoint

firstfile = Application.GetOpenFilename("Powerpoint Files (*.pps), *.pps")
If firstfile = False Then Exit Sub

'navigates to target directory and selects a file
mynewstring = firstfile

'next strip off filename to get just the directory name
ConditionIsMet = False

Do Until ConditionIsMet
y = X
On Error GoTo Err
X = Application.WorksheetFunction.Find("\", mynewstring)
mynewstring = Right(mynewstring, Len(mynewstring) - X)
Loop

myFileLen = Len(mynewstring)
directory = Left(firstfile, Len(firstfile) - myFileLen)
myRow = 1
Cells(myRow, 1) = "powerpoint"
Cells(myRow, 5) = "Grootte"
Cells(myRow, 6) = "Dag"
myRow = myRow + 1

'get first file info
mynewfile = Dir(directory, 7)
Cells(myRow, 1) = mynewfile
Cells(myRow, 5) = FileLen(directory & mynewfile) / 1000000
Cells(myRow, 6) = FileDateTime(directory & mynewfile)

'get remaining files' info
Do While mynewfile <> ""
mynewfile = Dir
If mynewfile <> "" And Right(mynewfile, 3) = "pps" Then
myRow = myRow + 1
Cells(myRow, 1) = mynewfile
Cells(myRow, 5) = FileLen(directory & mynewfile) / 1000000
Cells(myRow, 6) = FileDateTime(directory & mynewfile)
End If
Loop

MsgBox "alle namen zijn opgehaald"
Unload namenophalen

Exit Sub
Err:
ConditionIsMet = True
X = 0
Resume Next

End sub






Problem with this solution: I do not have the full path, and second - but that is minor - i have to choose one presentation to retrieve all. It would be more nice to choose a folder name.


Can someone be so kind to help me?
Thx in advance

Mario

Bob Phillips
08-24-2009, 07:19 AM
Private Sub CommandButton1_Click()
Dim fDir As FileDialog
Dim dName As String
Dim fName As String
Dim NextRow As Long

Set fDir = Application.FileDialog(msoFileDialogFolderPicker)
With fDir

.AllowMultiSelect = False

If .Show = -1 Then

dName = .SelectedItems(1) & Application.PathSeparator
fName = Dir(dName & "*.ppt*")
Do Until fName = ""

NextRow = NextRow + 1
Cells(NextRow, "A").Value = fName
Cells(NextRow, "B").Value = dName & fName
Cells(NextRow, "C").Value = Format(Date, "dd/mm/yyyy")
fName = Dir
Loop
End If
End With
End Sub

Mario62
08-24-2009, 07:50 AM
Hi xld - El Xid

Thanks for your quick answer!

i have past it and tried it out.
Two remarks if you don't mind::help
- for date is the result on every line the same day - today...
- and is it possible to have in column D the size of the file?

grtz
Mario

Bob Phillips
08-24-2009, 08:29 AM
What date are you after then?

Mario62
08-24-2009, 08:32 AM
Sorry if I was not clear...
It should be the date from every powerpoint... (think is date that it was made/altered)

Mario

Bob Phillips
08-24-2009, 08:36 AM
I thought it was the run date :)



Private Sub CommandButton1_Click()
Dim fDir As FileDialog
Dim dName As String
Dim fName As String
Dim NextRow As Long
Dim FSO As Object

Set fDir = Application.FileDialog(msoFileDialogFolderPicker)
With fDir

.AllowMultiSelect = False

If .Show = -1 Then

Set FSO = CreateObject("Scripting.FileSystemobject")
dName = .SelectedItems(1) & Application.PathSeparator
fName = Dir(dName & "*.ppt*")
Do Until fName = ""

NextRow = NextRow + 1
Cells(NextRow, "A").Value = fName
Cells(NextRow, "B").Value = dName & fName
Cells(NextRow, "C").Value = Format(FSO.getfile(dName & fName).DateLastModified, "dd/mm/yyyy")
Cells(NextRow, "D").Value = FSO.getfile(dName & fName).Size
fName = Dir
Loop
End If
End With
End Sub

Mario62
08-24-2009, 11:15 AM
xld,

A newbie knows when a master speaks.
Thank you master - this solution is very good!!:thumb
This is what I needed!

Thx again,
Mario