I have created a vba script for a document registers

S

suej68

the documents registers get the information of date created and
document name, hyperlink and path. and then the users put in
additional information after updating the files into the document.

however I have noticed that the document updates all the information
not just from the previous save date.

I have been given some script but it clears the sheet each time and
restarts the update.

Ideally I would like the update to start from the last save date and
pick up any documents saved into the nominated folders to add to the
list of documents.

Is this possible?

below is the code I have

Sub TestListFilesInFolder()

With Sheet1
.Cells.Clear
.Range("A3").Value = "Doc Number:"
.Range("B3").Value = "Direction:"
.Range("C3").Value = "File Type:"
.Range("D3").Value = "Date Created:"
.Range("E3").Value = "TO:"
.Range("F3").Value = "FROM:"
.Range("G3").Value = "Notes:"
.Range("H3").Value = "Short File Name:"
.Range("I3").Value = "Hyperlink:"
.Range("J3").Value = "Full Document Path:"
.Range("A3:J3").Font.Bold = True


End With

With Sheet1.Range("A1")
.Value = "Folder contents:"
.Font.Bold = True
.Font.Size = 12
End With

ListFilesInFolder "G:\Mining\Ventilation\16-Vent Upgrade 2010\",
True
' list all files included subfolders
End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As
Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As
Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long

Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)

With Sheet1
r = .Range("J65536").End(xlUp).Row + 1
For Each FileItem In SourceFolder.Files
' display file properties

.Cells(r, 3).Value = FileItem.Type
.Cells(r, 4).Value = FileItem.DateCreated
.Cells(r, 8).Value = FileItem.Name
.Cells(r, 10).Value = FileItem.path
.Cells(r, 9).Hyperlinks.Add Anchor:=.Cells(r, 9),
Address:=.Cells(r, 10).Value, ScreenTip:="Click to open",
TextToDisplay:=.Cells(r, 8).Value
' use file methods (not proper in this example)
' FileItem.Copy "C:\FolderName\Filename.txt", True
' FileItem.Move "C:\FolderName\Filename.txt"
' FileItem.Delete True
r = r + 1 ' next row number
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.path, True
Next SubFolder
End If
Columns("A:H").AutoFit
End With
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True

End Sub
 
S

suej68

the documents registers get the information of date created and
document name, hyperlink and path. and then the users put in
additional information after updating the files into the document.

however I have noticed that the document updates all the information
not just from the previous save date.

I have been given some script but it clears the sheet each time and
restarts the update.

Ideally I would like the update to start from the last save date and
pick up any documents saved into the nominated folders to add to the
list of documents.

Is this possible?

below is the code I have

Sub TestListFilesInFolder()

   With Sheet1
        .Cells.Clear
        .Range("A3").Value = "Doc Number:"
        .Range("B3").Value = "Direction:"
        .Range("C3").Value = "File Type:"
        .Range("D3").Value = "Date Created:"
        .Range("E3").Value = "TO:"
        .Range("F3").Value = "FROM:"
        .Range("G3").Value = "Notes:"
        .Range("H3").Value = "Short File Name:"
        .Range("I3").Value = "Hyperlink:"
        .Range("J3").Value = "Full Document Path:"
        .Range("A3:J3").Font.Bold = True

    End With

    With Sheet1.Range("A1")
        .Value = "Folder contents:"
        .Font.Bold = True
        .Font.Size = 12
    End With

    ListFilesInFolder "G:\Mining\Ventilation\16-Vent Upgrade 2010\",
True
    ' list all files included subfolders
End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As
Boolean)
     ' lists information about the files in SourceFolder
     ' example: ListFilesInFolder "C:\FolderName\", True
    Dim FSO As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder, SubFolder As
Scripting.Folder
    Dim FileItem As Scripting.File
    Dim r As Long

    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)

    With Sheet1
        r = .Range("J65536").End(xlUp).Row + 1
        For Each FileItem In SourceFolder.Files
             ' display file properties

        .Cells(r, 3).Value = FileItem.Type
            .Cells(r, 4).Value = FileItem.DateCreated
            .Cells(r, 8).Value = FileItem.Name
            .Cells(r, 10).Value = FileItem.path
            .Cells(r, 9).Hyperlinks.Add Anchor:=.Cells(r, 9),
Address:=.Cells(r, 10).Value, ScreenTip:="Click to open",
TextToDisplay:=.Cells(r, 8).Value
        ' use file methods (not proper in this example)
'        FileItem.Copy "C:\FolderName\Filename.txt", True
'        FileItem.Move "C:\FolderName\Filename.txt"
'        FileItem.Delete True
        r = r + 1 ' next row number
    Next FileItem
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.path, True
        Next SubFolder
    End If
    Columns("A:H").AutoFit
    End With
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    ActiveWorkbook.Saved = True

End Sub
Click to expand...



Sorry - I am using excel 2003
 
J

Jim Cone

Remove or comment out this line: ".Cells.Clear"
That will prevent the clearing of the sheet.
Where is the "previous save date" found?
--
Jim Cone
Portland, Oregon USA
http://tinyurl.com/ListFiles

..
..
..
"suej68" <[email protected]>
wrote in message
the documents registers get the information of date created and
document name, hyperlink and path. and then the users put in
additional information after updating the files into the document.
however I have noticed that the document updates all the information
not just from the previous save date.
I have been given some script but it clears the sheet each time and
restarts the update.
Ideally I would like the update to start from the last save date and
pick up any documents saved into the nominated folders to add to the
list of documents.
Is this possible?
below is the code I have

Sub TestListFilesInFolder()

With Sheet1
.Cells.Clear
.Range("A3").Value = "Doc Number:"
.Range("B3").Value = "Direction:"
.Range("C3").Value = "File Type:"
.Range("D3").Value = "Date Created:"
.Range("E3").Value = "TO:"
.Range("F3").Value = "FROM:"
.Range("G3").Value = "Notes:"
.Range("H3").Value = "Short File Name:"
.Range("I3").Value = "Hyperlink:"
.Range("J3").Value = "Full Document Path:"
.Range("A3:J3").Font.Bold = True
End With

With Sheet1.Range("A1")
.Value = "Folder contents:"
.Font.Bold = True
.Font.Size = 12
End With

ListFilesInFolder "G:\Mining\Ventilation\16-Vent Upgrade 2010\", True
' list all files included subfolders
End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long

Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)

With Sheet1
r = .Range("J65536").End(xlUp).Row + 1
For Each FileItem In SourceFolder.Files
' display file properties

.Cells(r, 3).Value = FileItem.Type
.Cells(r, 4).Value = FileItem.DateCreated
.Cells(r, 8).Value = FileItem.Name
.Cells(r, 10).Value = FileItem.path
.Cells(r, 9).Hyperlinks.Add Anchor:=.Cells(r, 9),
Address:=.Cells(r, 10).Value, ScreenTip:="Click to open",
TextToDisplay:=.Cells(r, 8).Value
' use file methods (not proper in this example)
' FileItem.Copy "C:\FolderName\Filename.txt", True
' FileItem.Move "C:\FolderName\Filename.txt"
' FileItem.Delete True
r = r + 1 ' next row number
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.path, True
Next SubFolder
End If
Columns("A:H").AutoFit
End With
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub
 
S

suej68

Remove or comment out this line:  ".Cells.Clear"
That will prevent the clearing of the sheet.
Where is the "previous save date" found?
--
Jim Cone
Portland, Oregon  USAhttp://tinyurl.com/ListFiles

.
.
.Jim
Click to expand...

the only save date that I have will be on the document properties.

unless you know of a way to tie it in to the code?

Sue
 
J

Jim Cone

Sub TestListFilesInFolder_R1()
Dim dteLastRun As Date

Application.ScreenUpdating = False
With Sheet1
' .Cells.Clear
.Range("A3").Value = "Doc Number:"
.Range("B3").Value = "Direction:"
.Range("C1").Value = "Last Run Date: "
.Range("C1").HorizontalAlignment = xlHAlignRight
.Range("C3").Value = "File Type:"
.Range("D3").Value = "Date Created:"
.Range("E3").Value = "TO:"
.Range("F3").Value = "FROM:"
.Range("G3").Value = "Notes:"
.Range("H3").Value = "Short File Name:"
.Range("I3").Value = "Hyperlink:"
.Range("J3").Value = "Full Document Path:"
.Range("A3:J3").Font.Bold = True
If IsDate(.Range("D1").Value) Then
dteLastRun = .Range("D1").Value
Else
dteLastRun = Now() - 30
End If
.Range("D1").Value = VBA.Format(Now(), "mmm/dd/yyyy")
End With

With Sheet1.Range("A1")
.Value = "Folder contents:"
.Font.Bold = True
.Font.Size = 12
End With

'list all files included subfolders
ListFilesInFolder "G:\Mining\Ventilation\16-Vent Upgrade 2010\", dteLastRun, True
Application.ScreenUpdating = True
End Sub

Sub ListFilesInFolder(SourceFolderName As String, ByRef dteLast As Date, IncludeSubfolders As Boolean)
'lists information about the files in SourceFolder
'example: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long

Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)

With Sheet1
r = .Range("J65536").End(xlUp).Row + 2
For Each FileItem In SourceFolder.Files
' display file properties
If FileItem.datecreated > dteLast Then
.Cells(r, 3).Value = FileItem.Type
.Cells(r, 4).Value = FileItem.datecreated
.Cells(r, 8).Value = FileItem.Name
.Cells(r, 10).Value = FileItem.Path
.Cells(r, 9).Hyperlinks.Add Anchor:=.Cells(r, 9), _
Address:=.Cells(r, 10).Value, _
ScreenTip:="Click to open", _
TextToDisplay:=.Cells(r, 8).Value
r = r + 1 ' next row number
End If
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, dteLast, True
Next SubFolder
End If
Columns("A:H").AutoFit
End With
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub
--
Jim Cone
Portland, Oregon USA
http://tinyurl.com/XLCompanion

..
..
..

"suej68" <[email protected]>
wrote in message
Remove or comment out this line: ".Cells.Clear"
That will prevent the clearing of the sheet.
Where is the "previous save date" found?
--
Jim Cone
Portland, Oregon USAhttp://tinyurl.com/ListFiles

.
.
.
Click to expand...

Jim
the only save date that I have will be on the document properties.
unless you know of a way to tie it in to the code?
Sue
 
S

suej68

Please report your results.
Click to expand...

I still haven't found a solution to my initial problem
however by using Removing "Cells.Clear" has solved the second one.

My file is running fine except when I go to update and it updates all
the files again.

is there a way to put code in that picks up new updates from the save
date of the document register.

eg if I save the document register today, the next time i open it, the
program looks at that date and updates newly added documents from the
folder?
 
S

suej68

Please report your results.
Click to expand...

Just has a brain storm with a staff member,

Could using the "date modified" in the folders be used and have an
update from the 1st of the month in the macro at all.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Sorting dates 1
Skip password protect files and open non protected files 5
File list macro 3
Listing the contents of a directory in a spreadsheet 2
reading and modifying file comments 3
vlookup issue 2
Edit VBA to print Directory including file owner into Excel Spread 8
Subtotal for same range of multiple worksheets 5

Top