Vbscript - Checking each subfolder for files and copy files

Posted by Kenny Bones on Stack Overflow See other posts from Stack Overflow or by Kenny Bones
Published on 2010-05-19T06:47:02Z Indexed on 2010/05/19 8:30 UTC
Read the original article Hit count: 780

I'm trying to get this script to work. It's basically supposed to mirror two sets of folders and make sure they are exactly the same. If a folder is missing, the folder and it's content should be copied.

Then the script should compare the DateModified attribute and only copy the files if the source file is newer than the destination file.

I'm trying to get together a script that does exactly that. And so far I've been able to check all subfolder if they exist and then create them if they don't. Then I've been able to scan the top source folder for it's files and copy them if they don't exist or if the DateModified attribute is newer on the source file.

What remains is basically scanning each subfolder for its files and copy them if they don't exist or if the DateModified stamp is newer.

Here's the code:

Dim strSourceFolder, strDestFolder

strSourceFolder = "c:\users\vegsan\desktop\Source\"
strDestFolder = "c:\users\vegsan\desktop\Dest\"

Set fso = CreateObject("Scripting.FileSystemObject")
Set objTopFolder = fso.GetFolder(strSourceFolder)
Set colTopFiles = objTopFolder.Files

'Check to see if subfolders actually exist. Create if they don't
Set objColFolders = objTopFolder.SubFolders
For Each subFolder in objColFolders
    CheckFolder subFolder, strSourceFolder, strDestFolder
Next

' Check all files in first top folder
For Each objFile in colTopFiles
    CheckFiles objFile, strSourceFolder, strDestFolder
Next

Sub CheckFolder (strSubFolder, strSourceFolder, strDestFolder)
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim folderName, aSplit

    aSplit = Split (strSubFolder, "\")
    UBound (aSplit)

    If UBound (aSplit) > 1 Then
        folderName = aSplit(UBound(aSplit))
        folderName = strDestFolder & folderName
    End if

    If Not fso.FolderExists(folderName) Then
        fso.CreateFolder(folderName)
    End if

End Sub

Sub CheckFiles (file, SourceFolder, DestFolder)

    Set fso = CreateObject("Scripting.FileSystemObject")
        Dim DateModified
        DateModified = file.DateLastModified
        ReplaceIfNewer file, DateMofidied, SourceFolder, DestFolder
End Sub


Sub ReplaceIfNewer (sourceFile, DateModified, SourceFolder, DestFolder)

    Const OVERWRITE_EXISTING = True
    Dim fso, objFolder, colFiles, sourceFileName, destFileName
    Dim DestDateModified, objDestFile

    Set fso = CreateObject("Scripting.FileSystemObject")

    sourceFileName = fso.GetFileName(sourceFile)
    destFileName = DestFolder & sourceFileName

    if Not fso.FileExists(destFileName) Then
        fso.CopyFile sourceFile, destFileName

    End if

    if fso.FileExists(destFileName) Then

        Set objDestFile = fso.GetFile(destFileName)
        DestDateModified = objDestFile.DateLastModified


        if DateModified <> DestDateModified Then
            fso.CopyFile sourceFile, destFileName
        End if

    End if

End Sub

© Stack Overflow or respective owner

Related posts about vbscript

Related posts about folder