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

Which workbook contains worksheet "DirList"? Thisworkbook refers to the
workbook containing the macro! If "DirList" is located in another workbook
then this error occurs.

Regards,
Stefi

€žBabs€� ezt Ã*rta:

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

Thanx for responding
Dirtlist is in the workbook in the path I have provided. The workbook
for which I have to find the last saved date. The file I am running
this is in C: and not S:, where the actual files are kept.

Regards,
Saumitra

Stefi wrote:
Which workbook contains worksheet "DirList"? Thisworkbook refers to the
workbook containing the macro! If "DirList" is located in another workbook
then this error occurs.

Regards,
Stefi

,,Babs" ezt írta:

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

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.

Insert here Workbook.Open filename:=myName 'this workbook contains sheet
"Dirlist", now you can set sh, but not in Thisworkbook but in Activeworkbook

Set sh = ActiveWorkbook.Worksheets("DirList")

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

Regards,
Stefi