#1   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
Posts: 6
Default 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

  #2   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
Posts: 5,441
Default 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



  #3   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
Posts: 6
Default 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

  #4   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
Posts: 5,441
Default 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



  #5   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
Posts: 6
Default 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




  #6   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
Posts: 5,441
Default 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




  #7   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
Posts: 6
Default 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



  #8   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
 
Posts: 5,441
Default 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





Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How do I get rid of an external link which I can't find? RaY Excel Discussion (Misc queries) 1 September 20th 06 04:54 PM
LINKEDRANGE function - a complement to the PULL function (for getting values from a closed workbook) [email protected] Excel Worksheet Functions 0 September 5th 06 03:44 PM
Finding a Problem Link in Excel Tracy B. Excel Discussion (Misc queries) 3 May 2nd 06 07:18 PM
Paste Link - retaining formatting Suzanne Marie Excel Discussion (Misc queries) 1 August 18th 05 02:02 AM
Breaking the link T New Users to Excel 1 May 4th 05 10:37 PM


All times are GMT +1. The time now is 12:47 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"