ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Worksheet Functions (https://www.excelbanter.com/excel-worksheet-functions/)
-   -   Link (https://www.excelbanter.com/excel-worksheet-functions/116687-link.html)

Babs
Link
 
Hi all,
I am in a fix. Can somebody help me with this code. I am
trying to pickup all system related details from location S:\ABC\Budget
2007\Budget2007\Central Functions\Submissions into spreadsheet on C:.
I am putting this code in a blank sheet.
But somehow it gives me error of "Script out of range". It gives error
at third statement Set sh = ThisWorkbook.Worksheets("DirList")
Can somebody please help me?
Its a bit urgent.
Thanking you
Regards,
Saumitra



Sub DirectorytoSheet()
Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets("DirList")
lstAttr = vbNormal + vbReadOnly + vbHidden
lstAttr = lstAttr + vbSystem + vbDirectory
lstAttr = lstAttr + vbArchive
myPath = "S:\ABC\Budget 2007\Budget2007\Central Functions\Submissions"
' Set the path.
myName = Dir(myPath, lstAttr) ' Retrieve the first entry.
sh.Cells(1, 1) = "Path:"
sh.Cells(1, 2) = myPath
sh.Cells(2, 2) = "Name"
sh.Cells(2, 3) = "Date"
sh.Cells(2, 4) = "Time"
sh.Cells(2, 5) = "Size"
sh.Cells(2, 6) = "Attr"
rw = 3
Do While myName < "" ' Start the loop.
' Ignore the current directory and
' the encompassing directory.
If myName < "." And myName < ".." Then
sh.Cells(rw, 2) = myName
sh.Cells(rw, 3) = _
Int(FileDateTime(myPath & myName))
sh.Cells(rw, 4) = _
FileDateTime(myPath & myName) - _
Int(FileDateTime(myPath & myName))
sh.Cells(rw, 5) = _
FileLen(myPath & myName)
fattr = GetAttr(myPath & myName)
strAttr = ""
If fattr < vbNormal Then '(vbNormal = 0 )
If (fattr And vbReadOnly) Then
strAttr = strAttr & "R"
End If
If (fattr And vbHidden) Then
strAttr = strAttr & "H"
End If
If (fattr And vbSystem) Then
strAttr = strAttr & "S"
End If
If (fattr And vbDirectory) Then
strAttr = strAttr & "D"
End If
If (fattr And vbArchive) Then
strAttr = strAttr & "A"
End If
End If
sh.Cells(rw, 6) = strAttr
rw = rw + 1
End If
myName = Dir ' Get next entry.
Loop
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("C:C")).Offset(2, 0).NumberFormat = _
"mm/dd/yy"
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("D:D")).Offset(2, 0).NumberFormat = _
"h:mm AM/PM"
End Sub

Bernie Deitrick
Link
 
Is your blank sheet named "DirList"? If not,

Set sh = ThisWorkbook.Worksheets(1)

should work OK.

HTH,
Bernie
MS Excel MVP


"Babs" wrote in message
ups.com...
Hi all,
I am in a fix. Can somebody help me with this code. I am
trying to pickup all system related details from location S:\ABC\Budget
2007\Budget2007\Central Functions\Submissions into spreadsheet on C:.
I am putting this code in a blank sheet.
But somehow it gives me error of "Script out of range". It gives error
at third statement Set sh = ThisWorkbook.Worksheets("DirList")
Can somebody please help me?
Its a bit urgent.
Thanking you
Regards,
Saumitra



Sub DirectorytoSheet()
Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets("DirList")
lstAttr = vbNormal + vbReadOnly + vbHidden
lstAttr = lstAttr + vbSystem + vbDirectory
lstAttr = lstAttr + vbArchive
myPath = "S:\ABC\Budget 2007\Budget2007\Central Functions\Submissions"
' Set the path.
myName = Dir(myPath, lstAttr) ' Retrieve the first entry.
sh.Cells(1, 1) = "Path:"
sh.Cells(1, 2) = myPath
sh.Cells(2, 2) = "Name"
sh.Cells(2, 3) = "Date"
sh.Cells(2, 4) = "Time"
sh.Cells(2, 5) = "Size"
sh.Cells(2, 6) = "Attr"
rw = 3
Do While myName < "" ' Start the loop.
' Ignore the current directory and
' the encompassing directory.
If myName < "." And myName < ".." Then
sh.Cells(rw, 2) = myName
sh.Cells(rw, 3) = _
Int(FileDateTime(myPath & myName))
sh.Cells(rw, 4) = _
FileDateTime(myPath & myName) - _
Int(FileDateTime(myPath & myName))
sh.Cells(rw, 5) = _
FileLen(myPath & myName)
fattr = GetAttr(myPath & myName)
strAttr = ""
If fattr < vbNormal Then '(vbNormal = 0 )
If (fattr And vbReadOnly) Then
strAttr = strAttr & "R"
End If
If (fattr And vbHidden) Then
strAttr = strAttr & "H"
End If
If (fattr And vbSystem) Then
strAttr = strAttr & "S"
End If
If (fattr And vbDirectory) Then
strAttr = strAttr & "D"
End If
If (fattr And vbArchive) Then
strAttr = strAttr & "A"
End If
End If
sh.Cells(rw, 6) = strAttr
rw = rw + 1
End If
myName = Dir ' Get next entry.
Loop
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("C:C")).Offset(2, 0).NumberFormat = _
"mm/dd/yy"
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("D:D")).Offset(2, 0).NumberFormat = _
"h:mm AM/PM"
End Sub

Babs
Link
 
Hi Bernie,
Now that problem is solved. The problem right now is in
statement
sh.Cells(rw, 3) = _
Int(FileDateTime(myPath & myName))

and gives error file not found, whereas the file exists in this folder.
It enters the loop and prints the name from myname.

Can you please help me?
Thanx
regards,
Saumitra

Sub DirectorytoSheet()
Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets("Sheet2")
lstAttr = vbNormal + vbReadOnly + vbHidden
lstAttr = lstAttr + vbSystem + vbDirectory
lstAttr = lstAttr + vbArchive
myPath = "C:\Documents and
Settings\kamats\Desktop\Saumitra\Budget\Finance Budget\Ashif v17.xls" '
Set the path.
myName = Dir(myPath, lstAttr) ' Retrieve the first entry.
sh.Cells(1, 1) = "Path:"
sh.Cells(1, 2) = myPath
sh.Cells(2, 2) = "Name"
sh.Cells(2, 3) = "Date"
sh.Cells(2, 4) = "Time"
sh.Cells(2, 5) = "Size"
sh.Cells(2, 6) = "Attr"
rw = 3
Do While myName < "" ' Start the loop.
' Ignore the current directory and
' the encompassing directory.
If myName < "." And myName < ".." Then
sh.Cells(rw, 2) = myName
sh.Cells(rw, 3) = _
Int(FileDateTime(myPath & myName))
sh.Cells(rw, 4) = _
FileDateTime(myPath & myName) - _
Int(FileDateTime(myPath & myName))
sh.Cells(rw, 5) = _
FileLen(myPath & myName)
fattr = GetAttr(myPath & myName)
strAttr = ""
If fattr < vbNormal Then '(vbNormal = 0 )
If (fattr And vbReadOnly) Then
strAttr = strAttr & "R"
End If
If (fattr And vbHidden) Then
strAttr = strAttr & "H"
End If
If (fattr And vbSystem) Then
strAttr = strAttr & "S"
End If
If (fattr And vbDirectory) Then
strAttr = strAttr & "D"
End If
If (fattr And vbArchive) Then
strAttr = strAttr & "A"
End If
End If
sh.Cells(rw, 6) = strAttr
rw = rw + 1
End If
myName = Dir ' Get next entry.
Loop
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("C:C")).Offset(2, 0).NumberFormat = _
"mm/dd/yy"
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("D:D")).Offset(2, 0).NumberFormat = _
"h:mm AM/PM"
End Sub

Bernie Deitrick
Link
 
Babs,

I think you need to set the path just as a path:

myPath = "C:\Documents and Settings\kamats\Desktop\Saumitra\Budget\Finance Budget\"


HTH,
Bernie
MS Excel MVP


"Babs" wrote in message
ups.com...
Hi Bernie,
Now that problem is solved. The problem right now is in
statement
sh.Cells(rw, 3) = _
Int(FileDateTime(myPath & myName))

and gives error file not found, whereas the file exists in this folder.
It enters the loop and prints the name from myname.

Can you please help me?
Thanx
regards,
Saumitra

Sub DirectorytoSheet()
Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets("Sheet2")
lstAttr = vbNormal + vbReadOnly + vbHidden
lstAttr = lstAttr + vbSystem + vbDirectory
lstAttr = lstAttr + vbArchive
myPath = "C:\Documents and
Settings\kamats\Desktop\Saumitra\Budget\Finance Budget\Ashif v17.xls" '
Set the path.
myName = Dir(myPath, lstAttr) ' Retrieve the first entry.
sh.Cells(1, 1) = "Path:"
sh.Cells(1, 2) = myPath
sh.Cells(2, 2) = "Name"
sh.Cells(2, 3) = "Date"
sh.Cells(2, 4) = "Time"
sh.Cells(2, 5) = "Size"
sh.Cells(2, 6) = "Attr"
rw = 3
Do While myName < "" ' Start the loop.
' Ignore the current directory and
' the encompassing directory.
If myName < "." And myName < ".." Then
sh.Cells(rw, 2) = myName
sh.Cells(rw, 3) = _
Int(FileDateTime(myPath & myName))
sh.Cells(rw, 4) = _
FileDateTime(myPath & myName) - _
Int(FileDateTime(myPath & myName))
sh.Cells(rw, 5) = _
FileLen(myPath & myName)
fattr = GetAttr(myPath & myName)
strAttr = ""
If fattr < vbNormal Then '(vbNormal = 0 )
If (fattr And vbReadOnly) Then
strAttr = strAttr & "R"
End If
If (fattr And vbHidden) Then
strAttr = strAttr & "H"
End If
If (fattr And vbSystem) Then
strAttr = strAttr & "S"
End If
If (fattr And vbDirectory) Then
strAttr = strAttr & "D"
End If
If (fattr And vbArchive) Then
strAttr = strAttr & "A"
End If
End If
sh.Cells(rw, 6) = strAttr
rw = rw + 1
End If
myName = Dir ' Get next entry.
Loop
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("C:C")).Offset(2, 0).NumberFormat = _
"mm/dd/yy"
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("D:D")).Offset(2, 0).NumberFormat = _
"h:mm AM/PM"
End Sub

Babs
Link
 
Thanx Bernie,
I think I have overcome that problem by changing
the macro to:

Filename = ":\Documents and
Settings\kamats\Desktop\Saumitra\Budget\Finance Budget"
updated = FileDateTime(Filename)

Range("a2").Select
ActiveCell.FormulaR1C1 = "Last updated"
Range("b2").Select
ActiveCell.FormulaR1C1 = Filename
Range("c2").Select
ActiveCell.FormulaR1C1 = updated

But th code does not pick up the files under that folder. The other
thing is I don't know how to write a do while loop to see all the
entries in the same folder. Can you please help me again? Its a bit
urgent.
Thanx
babs


Bernie Deitrick wrote:
Babs,

I think you need to set the path just as a path:

myPath = "C:\Documents and Settings\kamats\Desktop\Saumitra\Budget\Finance Budget\"


HTH,
Bernie
MS Excel MVP


"Babs" wrote in message
ups.com...
Hi Bernie,
Now that problem is solved. The problem right now is in
statement
sh.Cells(rw, 3) = _
Int(FileDateTime(myPath & myName))

and gives error file not found, whereas the file exists in this folder.
It enters the loop and prints the name from myname.

Can you please help me?
Thanx
regards,
Saumitra

Sub DirectorytoSheet()
Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets("Sheet2")
lstAttr = vbNormal + vbReadOnly + vbHidden
lstAttr = lstAttr + vbSystem + vbDirectory
lstAttr = lstAttr + vbArchive
myPath = "C:\Documents and
Settings\kamats\Desktop\Saumitra\Budget\Finance Budget\Ashif v17.xls" '
Set the path.
myName = Dir(myPath, lstAttr) ' Retrieve the first entry.
sh.Cells(1, 1) = "Path:"
sh.Cells(1, 2) = myPath
sh.Cells(2, 2) = "Name"
sh.Cells(2, 3) = "Date"
sh.Cells(2, 4) = "Time"
sh.Cells(2, 5) = "Size"
sh.Cells(2, 6) = "Attr"
rw = 3
Do While myName < "" ' Start the loop.
' Ignore the current directory and
' the encompassing directory.
If myName < "." And myName < ".." Then
sh.Cells(rw, 2) = myName
sh.Cells(rw, 3) = _
Int(FileDateTime(myPath & myName))
sh.Cells(rw, 4) = _
FileDateTime(myPath & myName) - _
Int(FileDateTime(myPath & myName))
sh.Cells(rw, 5) = _
FileLen(myPath & myName)
fattr = GetAttr(myPath & myName)
strAttr = ""
If fattr < vbNormal Then '(vbNormal = 0 )
If (fattr And vbReadOnly) Then
strAttr = strAttr & "R"
End If
If (fattr And vbHidden) Then
strAttr = strAttr & "H"
End If
If (fattr And vbSystem) Then
strAttr = strAttr & "S"
End If
If (fattr And vbDirectory) Then
strAttr = strAttr & "D"
End If
If (fattr And vbArchive) Then
strAttr = strAttr & "A"
End If
End If
sh.Cells(rw, 6) = strAttr
rw = rw + 1
End If
myName = Dir ' Get next entry.
Loop
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("C:C")).Offset(2, 0).NumberFormat = _
"mm/dd/yy"
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("D:D")).Offset(2, 0).NumberFormat = _
"h:mm AM/PM"
End Sub

Bernie Deitrick
Link
 
Babs,

The code below worked for me.

HTH,
Bernie
MS Excel MVP

Sub DirectorytoSheet()
Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets("Sheet2")
lstAttr = vbNormal + vbReadOnly + vbHidden
lstAttr = lstAttr + vbSystem + vbDirectory
lstAttr = lstAttr + vbArchive
myPath = "C:\Documents and Settings\kamats\Desktop\Saumitra\Budget\Finance Budget\"

myName = Dir(myPath, lstAttr) ' Retrieve the first entry.
sh.Cells(1, 1) = "Path:"
sh.Cells(1, 2) = myPath
sh.Cells(2, 2) = "Name"
sh.Cells(2, 3) = "Date"
sh.Cells(2, 4) = "Time"
sh.Cells(2, 5) = "Size"
sh.Cells(2, 6) = "Attr"
rw = 3
Do While myName < "" ' Start the loop.
' Ignore the current directory and
' the encompassing directory.
If myName < "." And myName < ".." Then
sh.Cells(rw, 2) = myName
sh.Cells(rw, 3) = _
Int(FileDateTime(myPath & "\" & myName))
sh.Cells(rw, 4) = _
FileDateTime(myPath & myName) - _
Int(FileDateTime(myPath & "\" & myName))
sh.Cells(rw, 5) = _
FileLen(myPath & myName)
fattr = GetAttr(myPath & "\" & myName)
strAttr = ""
If fattr < vbNormal Then '(vbNormal = 0 )
If (fattr And vbReadOnly) Then
strAttr = strAttr & "R"
End If
If (fattr And vbHidden) Then
strAttr = strAttr & "H"
End If
If (fattr And vbSystem) Then
strAttr = strAttr & "S"
End If
If (fattr And vbDirectory) Then
strAttr = strAttr & "D"
End If
If (fattr And vbArchive) Then
strAttr = strAttr & "A"
End If
End If
sh.Cells(rw, 6) = strAttr
rw = rw + 1
End If
myName = Dir ' Get next entry.
Loop
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("C:C")).Offset(2, 0).NumberFormat = _
"mm/dd/yy"
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("D:D")).Offset(2, 0).NumberFormat = _
"h:mm AM/PM"
End Sub




"Babs" wrote in message
ups.com...
Thanx Bernie,
I think I have overcome that problem by changing
the macro to:

Filename = ":\Documents and
Settings\kamats\Desktop\Saumitra\Budget\Finance Budget"
updated = FileDateTime(Filename)

Range("a2").Select
ActiveCell.FormulaR1C1 = "Last updated"
Range("b2").Select
ActiveCell.FormulaR1C1 = Filename
Range("c2").Select
ActiveCell.FormulaR1C1 = updated

But th code does not pick up the files under that folder. The other
thing is I don't know how to write a do while loop to see all the
entries in the same folder. Can you please help me again? Its a bit
urgent.
Thanx
babs


Bernie Deitrick wrote:
Babs,

I think you need to set the path just as a path:

myPath = "C:\Documents and Settings\kamats\Desktop\Saumitra\Budget\Finance Budget\"


HTH,
Bernie
MS Excel MVP


"Babs" wrote in message
ups.com...
Hi Bernie,
Now that problem is solved. The problem right now is in
statement
sh.Cells(rw, 3) = _
Int(FileDateTime(myPath & myName))

and gives error file not found, whereas the file exists in this folder.
It enters the loop and prints the name from myname.

Can you please help me?
Thanx
regards,
Saumitra

Sub DirectorytoSheet()
Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets("Sheet2")
lstAttr = vbNormal + vbReadOnly + vbHidden
lstAttr = lstAttr + vbSystem + vbDirectory
lstAttr = lstAttr + vbArchive
myPath = "C:\Documents and
Settings\kamats\Desktop\Saumitra\Budget\Finance Budget\Ashif v17.xls" '
Set the path.
myName = Dir(myPath, lstAttr) ' Retrieve the first entry.
sh.Cells(1, 1) = "Path:"
sh.Cells(1, 2) = myPath
sh.Cells(2, 2) = "Name"
sh.Cells(2, 3) = "Date"
sh.Cells(2, 4) = "Time"
sh.Cells(2, 5) = "Size"
sh.Cells(2, 6) = "Attr"
rw = 3
Do While myName < "" ' Start the loop.
' Ignore the current directory and
' the encompassing directory.
If myName < "." And myName < ".." Then
sh.Cells(rw, 2) = myName
sh.Cells(rw, 3) = _
Int(FileDateTime(myPath & myName))
sh.Cells(rw, 4) = _
FileDateTime(myPath & myName) - _
Int(FileDateTime(myPath & myName))
sh.Cells(rw, 5) = _
FileLen(myPath & myName)
fattr = GetAttr(myPath & myName)
strAttr = ""
If fattr < vbNormal Then '(vbNormal = 0 )
If (fattr And vbReadOnly) Then
strAttr = strAttr & "R"
End If
If (fattr And vbHidden) Then
strAttr = strAttr & "H"
End If
If (fattr And vbSystem) Then
strAttr = strAttr & "S"
End If
If (fattr And vbDirectory) Then
strAttr = strAttr & "D"
End If
If (fattr And vbArchive) Then
strAttr = strAttr & "A"
End If
End If
sh.Cells(rw, 6) = strAttr
rw = rw + 1
End If
myName = Dir ' Get next entry.
Loop
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("C:C")).Offset(2, 0).NumberFormat = _
"mm/dd/yy"
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("D:D")).Offset(2, 0).NumberFormat = _
"h:mm AM/PM"
End Sub

Babs
Link
 
Hi Bernie,
Thanks for your help. In addition to this,I would like
to see the contents of the subfolders also. Can you please help me on
this?

Regards,
babs

Bernie Deitrick wrote:
Babs,

The code below worked for me.

HTH,
Bernie
MS Excel MVP

Sub DirectorytoSheet()
Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets("Sheet2")
lstAttr = vbNormal + vbReadOnly + vbHidden
lstAttr = lstAttr + vbSystem + vbDirectory
lstAttr = lstAttr + vbArchive
myPath = "C:\Documents and Settings\kamats\Desktop\Saumitra\Budget\Finance Budget\"

myName = Dir(myPath, lstAttr) ' Retrieve the first entry.
sh.Cells(1, 1) = "Path:"
sh.Cells(1, 2) = myPath
sh.Cells(2, 2) = "Name"
sh.Cells(2, 3) = "Date"
sh.Cells(2, 4) = "Time"
sh.Cells(2, 5) = "Size"
sh.Cells(2, 6) = "Attr"
rw = 3
Do While myName < "" ' Start the loop.
' Ignore the current directory and
' the encompassing directory.
If myName < "." And myName < ".." Then
sh.Cells(rw, 2) = myName
sh.Cells(rw, 3) = _
Int(FileDateTime(myPath & "\" & myName))
sh.Cells(rw, 4) = _
FileDateTime(myPath & myName) - _
Int(FileDateTime(myPath & "\" & myName))
sh.Cells(rw, 5) = _
FileLen(myPath & myName)
fattr = GetAttr(myPath & "\" & myName)
strAttr = ""
If fattr < vbNormal Then '(vbNormal = 0 )
If (fattr And vbReadOnly) Then
strAttr = strAttr & "R"
End If
If (fattr And vbHidden) Then
strAttr = strAttr & "H"
End If
If (fattr And vbSystem) Then
strAttr = strAttr & "S"
End If
If (fattr And vbDirectory) Then
strAttr = strAttr & "D"
End If
If (fattr And vbArchive) Then
strAttr = strAttr & "A"
End If
End If
sh.Cells(rw, 6) = strAttr
rw = rw + 1
End If
myName = Dir ' Get next entry.
Loop
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("C:C")).Offset(2, 0).NumberFormat = _
"mm/dd/yy"
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("D:D")).Offset(2, 0).NumberFormat = _
"h:mm AM/PM"
End Sub




"Babs" wrote in message
ups.com...
Thanx Bernie,
I think I have overcome that problem by changing
the macro to:

Filename = ":\Documents and
Settings\kamats\Desktop\Saumitra\Budget\Finance Budget"
updated = FileDateTime(Filename)

Range("a2").Select
ActiveCell.FormulaR1C1 = "Last updated"
Range("b2").Select
ActiveCell.FormulaR1C1 = Filename
Range("c2").Select
ActiveCell.FormulaR1C1 = updated

But th code does not pick up the files under that folder. The other
thing is I don't know how to write a do while loop to see all the
entries in the same folder. Can you please help me again? Its a bit
urgent.
Thanx
babs


Bernie Deitrick wrote:
Babs,

I think you need to set the path just as a path:

myPath = "C:\Documents and Settings\kamats\Desktop\Saumitra\Budget\Finance Budget\"


HTH,
Bernie
MS Excel MVP


"Babs" wrote in message
ups.com...
Hi Bernie,
Now that problem is solved. The problem right now is in
statement
sh.Cells(rw, 3) = _
Int(FileDateTime(myPath & myName))

and gives error file not found, whereas the file exists in this folder.
It enters the loop and prints the name from myname.

Can you please help me?
Thanx
regards,
Saumitra

Sub DirectorytoSheet()
Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets("Sheet2")
lstAttr = vbNormal + vbReadOnly + vbHidden
lstAttr = lstAttr + vbSystem + vbDirectory
lstAttr = lstAttr + vbArchive
myPath = "C:\Documents and
Settings\kamats\Desktop\Saumitra\Budget\Finance Budget\Ashif v17.xls" '
Set the path.
myName = Dir(myPath, lstAttr) ' Retrieve the first entry.
sh.Cells(1, 1) = "Path:"
sh.Cells(1, 2) = myPath
sh.Cells(2, 2) = "Name"
sh.Cells(2, 3) = "Date"
sh.Cells(2, 4) = "Time"
sh.Cells(2, 5) = "Size"
sh.Cells(2, 6) = "Attr"
rw = 3
Do While myName < "" ' Start the loop.
' Ignore the current directory and
' the encompassing directory.
If myName < "." And myName < ".." Then
sh.Cells(rw, 2) = myName
sh.Cells(rw, 3) = _
Int(FileDateTime(myPath & myName))
sh.Cells(rw, 4) = _
FileDateTime(myPath & myName) - _
Int(FileDateTime(myPath & myName))
sh.Cells(rw, 5) = _
FileLen(myPath & myName)
fattr = GetAttr(myPath & myName)
strAttr = ""
If fattr < vbNormal Then '(vbNormal = 0 )
If (fattr And vbReadOnly) Then
strAttr = strAttr & "R"
End If
If (fattr And vbHidden) Then
strAttr = strAttr & "H"
End If
If (fattr And vbSystem) Then
strAttr = strAttr & "S"
End If
If (fattr And vbDirectory) Then
strAttr = strAttr & "D"
End If
If (fattr And vbArchive) Then
strAttr = strAttr & "A"
End If
End If
sh.Cells(rw, 6) = strAttr
rw = rw + 1
End If
myName = Dir ' Get next entry.
Loop
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("C:C")).Offset(2, 0).NumberFormat = _
"mm/dd/yy"
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("D:D")).Offset(2, 0).NumberFormat = _
"h:mm AM/PM"
End Sub

Bernie Deitrick
Link
 
Babs,

Then Dir is the worng approach. See the macro below.

HTH,
Bernie
MS Excel MVP

Sub DirectorytoSheetSubFolder()
Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets("Sheet2")
lstAttr = vbNormal + vbReadOnly + vbHidden
lstAttr = lstAttr + vbSystem + vbDirectory
lstAttr = lstAttr + vbArchive

sh.Cells(1, 1) = "Path:"
sh.Cells(2, 2) = "Name"
sh.Cells(2, 3) = "Date"
sh.Cells(2, 4) = "Time"
sh.Cells(2, 5) = "Size"
sh.Cells(2, 6) = "Attr"
rw = 3

With Application.FileSearch
.NewSearch
.LookIn = "C:\Documents and Settings\kamats\Desktop\Saumitra\Budget\Finance Budget"
sh.Cells(1, 2) = .LookIn
.SearchSubFolders = True
If .Execute(msoSortOrderDescending) 0 Then
MsgBox "There were " & .FoundFiles.Count & " file(s) found."
For i = 1 To .FoundFiles.Count

sh.Cells(rw, 2) = Replace(.FoundFiles(i), .LookIn & "\", "")
sh.Cells(rw, 3) = _
Int(FileDateTime(.FoundFiles(i)))
sh.Cells(rw, 4) = _
FileDateTime(.FoundFiles(i)) - _
Int(FileDateTime(.FoundFiles(i)))
sh.Cells(rw, 5) = _
FileLen(.FoundFiles(i))
fattr = GetAttr(.FoundFiles(i))
strAttr = ""
If fattr < vbNormal Then '(vbNormal = 0 )
If (fattr And vbReadOnly) Then
strAttr = strAttr & "R"
End If
If (fattr And vbHidden) Then
strAttr = strAttr & "H"
End If
If (fattr And vbSystem) Then
strAttr = strAttr & "S"
End If
If (fattr And vbDirectory) Then
strAttr = strAttr & "D"
End If
If (fattr And vbArchive) Then
strAttr = strAttr & "A"
End If
End If
sh.Cells(rw, 6) = strAttr
rw = rw + 1
Next i
Else
MsgBox "There were no files found."
End If
End With

Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("C:C")).Offset(2, 0).NumberFormat = _
"mm/dd/yy"
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("D:D")).Offset(2, 0).NumberFormat = _
"h:mm AM/PM"
End Sub




"Babs" wrote in message
ups.com...
Hi Bernie,
Thanks for your help. In addition to this,I would like
to see the contents of the subfolders also. Can you please help me on
this?

Regards,
babs

Bernie Deitrick wrote:
Babs,

The code below worked for me.

HTH,
Bernie
MS Excel MVP

Sub DirectorytoSheet()
Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets("Sheet2")
lstAttr = vbNormal + vbReadOnly + vbHidden
lstAttr = lstAttr + vbSystem + vbDirectory
lstAttr = lstAttr + vbArchive
myPath = "C:\Documents and Settings\kamats\Desktop\Saumitra\Budget\Finance Budget\"

myName = Dir(myPath, lstAttr) ' Retrieve the first entry.
sh.Cells(1, 1) = "Path:"
sh.Cells(1, 2) = myPath
sh.Cells(2, 2) = "Name"
sh.Cells(2, 3) = "Date"
sh.Cells(2, 4) = "Time"
sh.Cells(2, 5) = "Size"
sh.Cells(2, 6) = "Attr"
rw = 3
Do While myName < "" ' Start the loop.
' Ignore the current directory and
' the encompassing directory.
If myName < "." And myName < ".." Then
sh.Cells(rw, 2) = myName
sh.Cells(rw, 3) = _
Int(FileDateTime(myPath & "\" & myName))
sh.Cells(rw, 4) = _
FileDateTime(myPath & myName) - _
Int(FileDateTime(myPath & "\" & myName))
sh.Cells(rw, 5) = _
FileLen(myPath & myName)
fattr = GetAttr(myPath & "\" & myName)
strAttr = ""
If fattr < vbNormal Then '(vbNormal = 0 )
If (fattr And vbReadOnly) Then
strAttr = strAttr & "R"
End If
If (fattr And vbHidden) Then
strAttr = strAttr & "H"
End If
If (fattr And vbSystem) Then
strAttr = strAttr & "S"
End If
If (fattr And vbDirectory) Then
strAttr = strAttr & "D"
End If
If (fattr And vbArchive) Then
strAttr = strAttr & "A"
End If
End If
sh.Cells(rw, 6) = strAttr
rw = rw + 1
End If
myName = Dir ' Get next entry.
Loop
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("C:C")).Offset(2, 0).NumberFormat = _
"mm/dd/yy"
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("D:D")).Offset(2, 0).NumberFormat = _
"h:mm AM/PM"
End Sub




"Babs" wrote in message
ups.com...
Thanx Bernie,
I think I have overcome that problem by changing
the macro to:

Filename = ":\Documents and
Settings\kamats\Desktop\Saumitra\Budget\Finance Budget"
updated = FileDateTime(Filename)

Range("a2").Select
ActiveCell.FormulaR1C1 = "Last updated"
Range("b2").Select
ActiveCell.FormulaR1C1 = Filename
Range("c2").Select
ActiveCell.FormulaR1C1 = updated

But th code does not pick up the files under that folder. The other
thing is I don't know how to write a do while loop to see all the
entries in the same folder. Can you please help me again? Its a bit
urgent.
Thanx
babs


Bernie Deitrick wrote:
Babs,

I think you need to set the path just as a path:

myPath = "C:\Documents and Settings\kamats\Desktop\Saumitra\Budget\Finance Budget\"


HTH,
Bernie
MS Excel MVP


"Babs" wrote in message
ups.com...
Hi Bernie,
Now that problem is solved. The problem right now is in
statement
sh.Cells(rw, 3) = _
Int(FileDateTime(myPath & myName))

and gives error file not found, whereas the file exists in this folder.
It enters the loop and prints the name from myname.

Can you please help me?
Thanx
regards,
Saumitra

Sub DirectorytoSheet()
Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets("Sheet2")
lstAttr = vbNormal + vbReadOnly + vbHidden
lstAttr = lstAttr + vbSystem + vbDirectory
lstAttr = lstAttr + vbArchive
myPath = "C:\Documents and
Settings\kamats\Desktop\Saumitra\Budget\Finance Budget\Ashif v17.xls" '
Set the path.
myName = Dir(myPath, lstAttr) ' Retrieve the first entry.
sh.Cells(1, 1) = "Path:"
sh.Cells(1, 2) = myPath
sh.Cells(2, 2) = "Name"
sh.Cells(2, 3) = "Date"
sh.Cells(2, 4) = "Time"
sh.Cells(2, 5) = "Size"
sh.Cells(2, 6) = "Attr"
rw = 3
Do While myName < "" ' Start the loop.
' Ignore the current directory and
' the encompassing directory.
If myName < "." And myName < ".." Then
sh.Cells(rw, 2) = myName
sh.Cells(rw, 3) = _
Int(FileDateTime(myPath & myName))
sh.Cells(rw, 4) = _
FileDateTime(myPath & myName) - _
Int(FileDateTime(myPath & myName))
sh.Cells(rw, 5) = _
FileLen(myPath & myName)
fattr = GetAttr(myPath & myName)
strAttr = ""
If fattr < vbNormal Then '(vbNormal = 0 )
If (fattr And vbReadOnly) Then
strAttr = strAttr & "R"
End If
If (fattr And vbHidden) Then
strAttr = strAttr & "H"
End If
If (fattr And vbSystem) Then
strAttr = strAttr & "S"
End If
If (fattr And vbDirectory) Then
strAttr = strAttr & "D"
End If
If (fattr And vbArchive) Then
strAttr = strAttr & "A"
End If
End If
sh.Cells(rw, 6) = strAttr
rw = rw + 1
End If
myName = Dir ' Get next entry.
Loop
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("C:C")).Offset(2, 0).NumberFormat = _
"mm/dd/yy"
Intersect(sh.Range("A1").CurrentRegion, _
sh.Columns("D:D")).Offset(2, 0).NumberFormat = _
"h:mm AM/PM"
End Sub


All times are GMT +1. The time now is 07:13 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com