Copy latest DIRs...using FileSysObj or DOS-DIR? 
Author Message
 Copy latest DIRs...using FileSysObj or DOS-DIR?

Hi,
I've got a lot of DIRs on an FTP-Server and I want to write a Script
that finds the latest 10/20 or whatever DIRs in lots of different DIRs
on different HDs and then copies them into a /newstuff/ DiR for
example. So I'd like to know if anyone has got an idea how to realise
this the most efficient and easy way anf if there is maybe already a
Script that does something similar.

Greetings,

markus



Fri, 09 Jul 2004 16:18:23 GMT  
 Copy latest DIRs...using FileSysObj or DOS-DIR?
Aeh well I found an easy way to do it....so here's my code (it's not
"clean" I know but it works...and some code is stolen from someone I
think...found it on my HD but dunno who did it...)

The File dirlist.txt should just have the DIR-Paths like

C:\downloads\
D:\downloads\mp3s\

etc....

' ######## replace.vbs ############
' Searches in lots of DIRs for latest DIRs and then copies them into
another DIR
:}
'
'  
Option Explicit
'
'
' TargetDir must have \ at the end!
TargetDir = "C:\targetdir\"
' Location of DIR-List to check for new files (doesn't check subdirs
but copies them...)
Dirlistfile = "C:\dirlist.txt"
' The last X DIRs should be copied...
Latestmax = 20

' Code....

Dim rsFiles

Const adVarChar = 200, adDate = 7

Set rsFiles = CreateObject("ADODB.Recordset")
rsFiles.Fields.Append "Name", adVarChar, 255
rsFiles.Fields.Append "Path", adVarChar, 255
rsFiles.Fields.Append "Created", adDate
rsFiles.Open

Dim Directory, TargetDir, Dirlistfile, Latestmax, Counter

Counter = 0

Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1

Dim fin
Set fin = fso.OpenTextFile(Dirlistfile, ForReading)

Do While fin.AtEndOfStream <> True
        Directory = fin.ReadLine
        GetDirList(Directory)
Loop

fin.Close

Dim fsoFiles, SubDir

Function GetDirList(Directory)

Set fsoFiles = CreateObject("Scripting.FileSystemObject").GetFolder(Directory).Subfolders

For Each SubDir in fsoFiles
    rsFiles.AddNew
    rsFiles.Fields("Name").Value = SubDir.Name
    rsFiles.Fields("Path").Value = SubDir.Path
    On Error Resume Next
    rsFiles.Fields("Created").Value = SubDir.DateCreated
    On Error GoTo 0
Next

End Function

rsFiles.Sort = "Created DESC"

Dim fsocopyFiles, DirPath, DirName, DelFolder
Set fsocopyFiles = CreateObject("Scripting.FileSystemObject")

if fsocopyFiles.FolderExists(TargetDir) then
Set DelFolder = fsocopyFiles.GetFolder(TargetDir)
DelFolder.Delete
End If

if not fsocopyFiles.FolderExists(TargetDir) then
    fsocopyFiles.createFolder(TargetDir)
End If

Do Until rsFiles.EOF
    If Counter = Latestmax then
        Exit Do
    End If
   Counter = Counter + 1

    DirName = rsFiles.Fields("Name").Value
    DirPath = rsFiles.Fields("Path").Value

        fsocopyFiles.CopyFolder "" & DirPath & "", "" & TargetDir & ""

  rsFiles.MoveNext
Loop

' EOF

Quote:

> Hi,
> I've got a lot of DIRs on an FTP-Server and I want to write a Script
> that finds the latest 10/20 or whatever DIRs in lots of different DIRs
> on different HDs and then copies them into a /newstuff/ DiR for
> example. So I'd like to know if anyone has got an idea how to realise
> this the most efficient and easy way anf if there is maybe already a
> Script that does something similar.

> Greetings,

> markus



Fri, 09 Jul 2004 21:44:13 GMT  
 
 [ 2 post ] 

 Relevant Pages 

1. FileSysObj - How do you emulate a dir *.xxx

2. Detect new/removed files from Dir + sub-dirs ?

3. Hidden Dirs in a Dir Listbox

4. Dir won't give me just DIRs in VB 4.0

5. Copy Dirs

6. How to make DIR , delete DIR using wininet.dll

7. How to make DIR , delete DIR using wininet.dll

8. --- copying a PostSctipt file with the DOS COPY command

9. using DOS functioin COPY from VB program

10. Using treeview to read dirs on a drive

11. Copying files to WinNT dir via logon script?

12. Copying files to WinNT dir via logon script?

 

 
Powered by phpBB® Forum Software