|
a macro with finishing criteria
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 |
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 |
a macro with finishing criteria
Tried and it works great..
i will keep on testing it . :) thank you with coming appreciation... -- regards "Jacob Skaria" wrote: 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 |
| All times are GMT +1. The time now is 09:06 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com