macro function--very nice

[driller]

Hello genuine guys,

Is the macro function <see below> here still possible for adjustment so I
can use this very good macro, productively, as often as needed ? Data to
build are "filenames" <i.e. “*.pdfâ€,..>

Steps Criteria :
Source address is in A1
1st the generated list of filenames shall be on Col A2~C, start row 2
2nd the next generated list of filenames (e.g. after re-using the function
again) shall append/build-up from the bottom of previously generated row of
data.

The filenames are searched from a folder address as written in A1.
This folder stores files in a daily basis.
Bottom line, I have to perform a routine listing of filenames without
re-building the previously gathered filenames.

--
Sub FilelistUpdates()
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("A2:C2").Resize(ws.Cells(Rows.Count,
"A").End(xlUp).Row).ClearContents

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

For Each fl In folder.Files
'ws.Range("A" & lngRow).Formula = "=hyperlink(""" & folder.Path & "\" &
fl.Name & """,""" & fl.Name & """)"
ws.Range("A" & lngRow).Formula = "=hyperlink(""" & folder.Path & "\" &
fl.Name & """,""" & fl.Parentfolder.Name & "\" & fl.Name & """)"

ws.Range("B" & lngRow) = fl.Size
ws.Range("C" & lngRow) = fl.DateLastModified
lngRow = lngRow + 1
Next

End If
Next
End Sub
--
The above macro works for me yesterday, then when i re-hit the function
today, the new list are generated and the yesterday's filename list were
rearranged.
I have already written working/recording notes along Col. D for each
filename yesterday and now I have to re-arranged it <where it fits> all over
again...

I am not familiar yet with ms access..i believe excel is more powerful and
flexible..

 

[Joel]

the number of the files in your search may change from day to day. You must
first see if the file already exists in column A. If the filst exists then
you only want to update the file size and last modified. Otherwise you want
to add anew row

Excel and Access each have ther own advantages and disadvantes. the VBA
language is the same and the file structures are very similar. the
Application is idfferent. Access is better for large databases and if you
require filesharing. Excel is more user friendly in the methods you use to
enter data and formulas; and the way the data is displayed and formated.

Try these changes.

Sub FilelistUpdates()
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("A2:C2").Resize(ws.Cells(Rows.Count,
"A").End(xlUp).Row).ClearContents

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

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 & """,""" & FName & """)"
lngRow = lngRow + 1
else
DataRow = c.row
end if

ws.Range("B" & DataRow) = fl.Size
ws.Range("C" & DataRow) = fl.DateLastModified

Next

End If
Next
End Sub

 

[Joel]

I don't rember if I put the new code in the posting. Here is the code again
if I forgot.

Sub FilelistUpdates()
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("A2:C2").Resize(ws.Cells(Rows.Count,
"A").End(xlUp).Row).ClearContents

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

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 & """,""" & FName & """)"
lngRow = lngRow + 1
else
DataRow = c.row
end if

ws.Range("B" & DataRow) = fl.Size
ws.Range("C" & DataRow) = fl.DateLastModified

Next

End If
Next
End Sub

 

[driller]

thanks for reply, results is the same

I test the new macro in this manner
A1 = d:\temp ----->with 3 files inside
1st : macro.. run > filelistupdate.
result is
B1.pdf....
C2.pdf...
D3.pdf...

then i place two file in the folder d:\temp ----> (i.e. "A0.pdf" and "E4.pdf")
2nd : macro.. run > filelistupdate.
result is then fully rearranged below
A0.pdf...
B1.pdf....
C2.pdf...
D3.pdf...
E4.pdf...

Is it possible to have the result arranged like this way..
B1.pdf....
C2.pdf...
D3.pdf...
A0.pdf...
E4.pdf...

I need to sustain the first run arrangement since my routine is to write
texts (notes) in every row (along col. D) corresponding to such specific
filename from Col A. If the filenames are re-arranged on the next run of
macro, i will loose the first combined matching arrangement (Col A~D).
The quantity of files in the folders are building-up on daily basis.

 

[Joel]

The solution is simple. Remove this line

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

It is clearing the old data each time you run the macro.

I need to know more details on why you want the order below. The code with
my latest change will keep your notes and preserve the same order every time
the macro is run. What is won't do is delete data if the file is no longer
exists. I cna modify the code to delete (or indicate) which files no longer
exists. What I could do is put an X in column IV when every any file are
found. Then remove the lines that don't have X's. Then remove column IV.

B1.pdf....
C2.pdf...
D3.pdf...
A0.pdf...
E4.pdf...

 

[driller]

I remove the *clearing lines*. It did what i expected.

And, now you're giving me more than i can think of in advance..THAT'S A
GREAT IDEA !!!

exists. What I could do is put an X in column IV when every any file are
found. Then remove the lines that don't have X's. Then remove column IV.

thanks for the x's but i like it to be placed along Col. AA. that's an
extra control measure !!!

 

[Joel]

Sub FilelistUpdates()
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 & """,""" & FName & """)"
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]

you're a genuine indeed ! keep it up !

i hope we can place the word "Gone with the Wind" if it is not traceable in
the folder (har har har)

Perfect Job !