View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
suej68 suej68 is offline
external usenet poster
 
Posts: 5
Default I have created a vba script for a document registers

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