Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
![]()
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
![]()
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
How do I get rid of an external link which I can't find? | Excel Discussion (Misc queries) | |||
LINKEDRANGE function - a complement to the PULL function (for getting values from a closed workbook) | Excel Worksheet Functions | |||
Finding a Problem Link in Excel | Excel Discussion (Misc queries) | |||
Paste Link - retaining formatting | Excel Discussion (Misc queries) | |||
Breaking the link | New Users to Excel |