View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.misc
Jacob Skaria Jacob Skaria is offline
external usenet poster
 
Posts: 8,520
Default a macro with finishing criteria

Try the below...

Sub GetFileDetails()
'Jacob Skaria: 10 Oct 2009
Dim fso As Object, folder As Object
Dim lngRow As Long, ws As Worksheet
Dim strPassword As String
Set fso = CreateObject("Scripting.FileSystemObject")

If ActiveSheet.Name = "mymastersheet" Then
strPassword = InputBox("Enter password")
Else: Exit Sub: End If

For Each ws In Worksheets
ws.Unprotect Password:=strPassword
ws.Range("D1").Resize(ws.Cells(Rows.Count, _
"A").End(xlUp).Row).Value = "Not found"
ws.Range("D1") = "Status"

If fso.FolderExists(ws.Range("A1")) Then
Set folder = fso.GetFolder(ws.Range("A1"))
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1

For Each fl In folder.Files

Set rngFound = ws.Range("A:A").Find(fl.Name, LookAt:=xlPart)

If rngFound Is Nothing Then
ws.Range("A" & lngRow).Formula = _
"=hyperlink(""" & folder.Path & _
"\" & fl.Name & """,""" & fl.Name & """)"
ws.Range("B" & lngRow) = fl.Size
ws.Range("C" & lngRow) = fl.DateLastModified
ws.Range("D" & lngRow) = "New"
lngRow = lngRow + 1
Else
If ws.Range("B" & rngFound.Row) = fl.Size And _
ws.Range("C" & rngFound.Row) = fl.DateLastModified Then
ws.Range("D" & rngFound.Row) = "No change"
Else
ws.Range("D" & rngFound.Row) = "Modified"
End If
End If
Next

End If
ws.Protect Password:=strPassword
Next
End Sub


If this post helps click Yes
---------------
Jacob Skaria


"driller2" wrote:


Hello again,

i have found a bright macro so quick to handle and i like it to perform
basically with one last finishing criteria.

In myWorkbook, every sheets have a password, except on mymastersheet.

On protected Sheets, the columns are divided into 2 types.
Protection enabled at columns A~D
Protection disabled at columns E~IV
No ColumnIs are now suggested to be hidden <before or after running
macro.

1) Is it possible to prompt this macro while my active sheet is the
mymastersheet?
2) If not, then what line should i add/remove/modify in order to make
myWorkbook easy to handle. I like the macro, if possible, to reinstate
the password protection after running...

----
Sub GetFileDetails()
'Jacob Skaria: 10 Oct 2009
Dim fso As Object, folder As Object
Dim lngRow As Long, ws As Worksheet

Set fso = CreateObject("Scripting.FileSystemObject")

For Each ws In Worksheets
ws.Range("D1").Resize(ws.Cells(Rows.Count, "A").End(xlUp).Row).Value =
"Not found"
ws.Range("D1") = "Status"

If fso.FolderExists(ws.Range("A1")) Then
Set folder = fso.GetFolder(ws.Range("A1"))
lngRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1

For Each fl In folder.Files

Set rngFound = ws.Range("A:A").Find(fl.Name, LookAt:=xlPart)

If rngFound Is Nothing Then
ws.Range("A" & lngRow).Formula = "=hyperlink(""" & folder.Path &
"\" & fl.Name & """,""" & fl.Name & """)"
ws.Range("B" & lngRow) = fl.Size
ws.Range("C" & lngRow) = fl.DateLastModified
ws.Range("D" & lngRow) = "New"
lngRow = lngRow + 1
Else
If ws.Range("B" & rngFound.Row) = fl.Size And ws.Range("C" &
rngFound.Row) = fl.DateLastModified Then
ws.Range("D" & rngFound.Row) = "No change"
Else
ws.Range("D" & rngFound.Row) = "Modified"
End If
End If
Next

End If
Next
End Sub
----

finishing ideas are well appreciaIed :)

--
regards




--
driller2