macro works - very quick

[driller]

hello,

for sure again this is another count of appreciation.
i have this very good macro that works for sheet1 only. What is the syntax
to modify this nice macro in order that it can work for a varying number of
sheets <by clicking the macro function just once> in myworkbook based on one
criteria below.

If there's an existing folder address written in A1 <among all sheets>, then
proceed with the macro for these sheets, otherwise do not proceed only on the
sheet without a valid written address on A1.

Meaning if I have 3 sheets.
Sheet1!A1 = d:\temp
Sheet2!A1 = "blank" or "ab3d" or "123"
Sheet3!A1 = c:\temp

then, i like the nicer macro to run only on Sheet1 & Sheet3 assuming the
written address are valid/existing in my computer.

i hope it can be possible. thank you in advance..

 

[driller]

ooops..

here is the nice code
------
Sub FilelistUpdateExist()
Dim fso As Object, folder As Object
Dim lngRow As Long, ws As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")

For Each ws In Worksheets


If fso.FolderExists(ws.Range("A1")) Then
Set folder = fso.GetFolder(ws.Range("A1"))

lngRow = ws.Range("A" & Rows.Count).End(xlUp).Row
lngRow = lngRow + 1

'clear column AA used to determine if file still exists
ws.Columns("AA").ClearContents
ws.Range("AA1") = "File Status"
For Each Fl In folder.Files
FName = folder.Path & "\" & Fl.Name
Set c = ws.Columns("A").Find(what:=FName, _
LookIn:=xlValues, lookat:=xlWhole)

If c Is Nothing Then
DataRow = lngRow
ws.Range("A" & DataRow).Formula = _
"=hyperlink(""" & FName & """,""" & Fl.Name & """)"
lngRow = lngRow + 1
NewFile = True
Else
DataRow = c.Row
NewFile = False
End If

If NewFile = True Then
ws.Range("AA" & DataRow) = "New"
Else
If ws.Range("B" & DataRow) = Fl.Size And _
ws.Range("C" & DataRow) = Fl.DateLastModified Then

ws.Range("AA" & DataRow) = "No Changes"
Else
ws.Range("AA" & DataRow) = "Updated"
End If
End If
ws.Range("B" & DataRow) = Fl.Size
ws.Range("C" & DataRow) = Fl.DateLastModified

Next

End If
Next ws
End Sub

 

[Gary''s Student]

I would just test it directly:

Sub PickSSheet()
Dim ws As Worksheet
s1 = "c:\"
s2 = "d:\"
For Each ws In Worksheets
v = Left(ws.Range("A1").Value, 3)
If v = s1 Or v = s2 Then
MsgBox ws.Name
End If
Next
End Sub

 

[Jacob Skaria]

Hi Again

--The below line in the macro does that already...It checks whether the path
is valid
If fso.FolderExists(ws.Range("A1")) Then

--Additionally if you are looking to clear the contents of the sheet (as we
did in the other macro named GetFileDetails() posted on 10/6/2009 ) then you
can use the below code just below the For loop..Refer the other macro and you
will get how that is done...

ws.Range("A2:C2").Resize(ws.Cells(Rows.Count, _
"A").End(xlUp).Row).ClearContents

If this post helps click Yes

 

[driller]

Yeh, our previous one code works for a *one day* collection of filenames.

the new modified code, when i run it today (i.e. twice or more), the macro
keeps on populating the same filenames. Yesterday, this had worked yet now,
no idea whats happening.

pls. clarify the need for a little more change - the mycode is sure *very
quick* but may had forgotten the intent that no double-filenames must be
populated.
I need to populate only those filenames that had been newly collected in the
folder.

pls try this also.
--
Sub FilelistUpdateExist()
Dim fso As Object, folder As Object
Dim lngRow As Long, ws As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")

For Each ws In Worksheets


If fso.FolderExists(ws.Range("A1")) Then
Set folder = fso.GetFolder(ws.Range("A1"))

lngRow = ws.Range("A" & Rows.Count).End(xlUp).Row
lngRow = lngRow + 1

'clear column AA used to determine if file still exists
ws.Columns("AA").ClearContents
ws.Range("AA1") = "File Status"
For Each Fl In folder.Files
FName = folder.Path & "\" & Fl.Name
Set c = ws.Columns("A").Find(what:=FName, _
LookIn:=xlValues, lookat:=xlWhole)

If c Is Nothing Then
DataRow = lngRow
ws.Range("A" & DataRow).Formula = _
"=hyperlink(""" & FName & """,""" & Fl.Name & """)"
lngRow = lngRow + 1
NewFile = True
Else
DataRow = c.Row
NewFile = False
End If

If NewFile = True Then
ws.Range("AA" & DataRow) = "New"
Else
If ws.Range("B" & DataRow) = Fl.Size And _
ws.Range("C" & DataRow) = Fl.DateLastModified Then

ws.Range("AA" & DataRow) = "No Changes"
Else
ws.Range("AA" & DataRow) = "Updated"
End If
End If
ws.Range("B" & DataRow) = Fl.Size
ws.Range("C" & DataRow) = Fl.DateLastModified

Next

End If
Next ws
End Sub

 

[driller]

hi again,

the new modified code, when i run it today (i.e. twice or more), the macro
keeps on populating the same filenames. Yesterday, this had worked yet now,
no idea whats happening.

pls. clarify the need for a little more change - the mycode is sure *very
quick* but may had forgotten the intent that no double-filenames must be
populated.
I need to populate only those filenames that had been newly collected in the
folder.

pls try this also.
--
Sub FilelistUpdateExist()
Dim fso As Object, folder As Object
Dim lngRow As Long, ws As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")

For Each ws In Worksheets


If fso.FolderExists(ws.Range("A1")) Then
Set folder = fso.GetFolder(ws.Range("A1"))

lngRow = ws.Range("A" & Rows.Count).End(xlUp).Row
lngRow = lngRow + 1

'clear column AA used to determine if file still exists
ws.Columns("AA").ClearContents
ws.Range("AA1") = "File Status"
For Each Fl In folder.Files
FName = folder.Path & "\" & Fl.Name
Set c = ws.Columns("A").Find(what:=FName, _
LookIn:=xlValues, lookat:=xlWhole)

If c Is Nothing Then
DataRow = lngRow
ws.Range("A" & DataRow).Formula = _
"=hyperlink(""" & FName & """,""" & Fl.Name & """)"
lngRow = lngRow + 1
NewFile = True
Else
DataRow = c.Row
NewFile = False
End If

If NewFile = True Then
ws.Range("AA" & DataRow) = "New"
Else
If ws.Range("B" & DataRow) = Fl.Size And _
ws.Range("C" & DataRow) = Fl.DateLastModified Then

ws.Range("AA" & DataRow) = "No Changes"
Else
ws.Range("AA" & DataRow) = "Updated"
End If
End If
ws.Range("B" & DataRow) = Fl.Size
ws.Range("C" & DataRow) = Fl.DateLastModified

Next

End If
Next ws
End Sub

 

[Jacob Skaria]

I have modified the other macro to suit your requirement....The status is
updated to Column D..Modify to suit..One more addition is files which are
deleted or not present will be marked 'Not Found". Try and feedback

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 = 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

If this post helps click Yes