Recursive search/move files 1

[smurfhell]

I have a computer running Win2K Server. I need a script that can do a recursive search for *.bak files in a directory and move the files to another location. For example:

Search C:\projects and all subfolders (up to 10 folders deep) for *.bak files and move them to another folder on the computer.

I have only found one script that will do recursive wildcard searching, but it only works with Server 2003 or WinXP because of the "LIKE" parameter. Any help or suggestions would be greatly appreciated.

 

[PHV]

There are MANY recursive search scripts in this forum.
Do a keyword search for fso recursive
You don't need the Like operator:
If UCase(Right(FileName, 4)) = ".BAK" Then

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[smurfhell]

I did a search before I posted this...there isn't much regarding recursive searching. I don't have a version of Visual or any other programming software except for Notepad-that is why I need to find some type of script. Could you point me in the right direction? Thanks for the help.

 

[trollacious]

I have a .vbs file I modify and use to back up certain folders that could be easily adapted to move files with certain extensions only. No warranty, but I've used it for a few years without any problems. It backs up the directory structure, as well, but can be modified to skip that. It probably has some redundancy in it with the FSO, but it works. It's recursive, as you requested, too.

Lee

 

[tsuji]

Hello smurfhell,

I hook this up in express for illustration. It returns an array listing all the files' full paths in the tree structure. The depth is respected the larger index the deeper. I prefer this enumeration first before doing anything to the files because it will not commit anything physically avoiding encountering error midway. Second advantage is that it makes recursive procedure clean in its objective.

rootspec="d:\test"

set fso=createobject("scripting.filesystemobject")
if not fso.folderexists(rootspec) then
    wscript.echo "Root directory not found. Operation aborted."
    set fso=nothing
    wscript.quit 9
end if

dim afiletree() : redim afiletree(-1)
createobject("wscript.shell").popup "Will take a while to complete...",3
iret=buildfiletree(rootspec,afiletree,fso) : set fso=nothing
if iret<>0 then
    on error resume next
    err.raise iret
    wscript.echo "error found : " & err.number & vbcrlf & err.description
    err.clear
    on error goto 0
else
    '<<<<<<<<<do other useful stuff here---reason for enumeration
end if
erase afiletree

'the key function buildfiletree
function buildfiletree(srootvalid,afile,fso)
    'errorless return 0
    'else return error number first encountered
    'afile return preserveed as the state just before the error encountered.

    buildfiletree=0
    on error resume next
    set ofolder=fso.getfolder(srootvalid)
    ifound=ofolder.files.count
    if ifound<>0 then
        iref=ubound(afile) : icount=0
        redim preserve afile(iref+ifound)
        for each ofile in ofolder.files
            icount=icount+1
            afile(iref+icount)=ofile.path
        next
    end if
    if ofolder.subfolders.count<>0 then
        for each osubfolder in ofolder.subfolders
            iretdyn=buildfiletree(osubfolder.path,afile,fso)
        next
    end if
    set ofolder=nothing
    if iretdyn<>0 then
        buildfiletree=iretdyn
    elseif err.number<>0 then
        buildfiletree=err.number : err.clear
    end if
    on error goto 0
end function

This function will not filter file-extension. If you need to do so, as you said, a simple modification will do. It is done like this.

rootspec="d:\test"
sext="exe"

set fso=createobject("scripting.filesystemobject")
if not fso.folderexists(rootspec) then
    wscript.echo "Root directory not found. Operation aborted."
    set fso=nothing
    wscript.quit 9
end if

dim afiletree() : redim afiletree(-1)
createobject("wscript.shell").popup "Will take a while to complete...",3
iret=buildfiletree_x(rootspec,afiletree,fso,sext) : set fso=nothing

if iret<>0 then
    on error resume next
    err.raise iret
    wscript.echo "error found : " & err.number & vbcrlf & err.description
    err.clear
    on error goto 0
else
    '<<<<<<<<<do other useful stuff here---reason for enumeration
end if
erase afiletree

'the key function buildfiletree_x
function buildfiletree_x(srootvalid,afile,fso,sext)
    'errorless return 0
    'else return error number first encountered
    'afile return preserveed as the state just before the error encountered.

    buildfiletree_x=0
    on error resume next
    set ofolder=fso.getfolder(srootvalid)
    ifound=ofolder.files.count
    if ifound<>0 then
        for each ofile in ofolder.files
            if strcomp(fso.getextensionname(ofile.name),sext,1)=0 then
                redim preserve afile(ubound(afile)+1)
                afile(ubound(afile))=ofile.path
            end if
        next
    end if
    if ofolder.subfolders.count<>0 then
        for each osubfolder in ofolder.subfolders
            iretdyn=buildfiletree_x(osubfolder.path,afile,fso,sext)
        next
    end if
    set ofolder=nothing
    if iretdyn<>0 then
        buildfiletree_x=iretdyn
    elseif err.number<>0 then
        buildfiletree_x=err.number : err.clear
    end if
    on error goto 0
end function

regards - tsuji

 

[trollacious]

What I use this kind of script for is an updater, and it only copies the files if the backup copies are older. It can be modified to not recreate the directory tree, if you want to copy the files to one central directory. This is the template I use for the different scripts I use to back up things I want.

Option Explicit

Dim driveobj, fileset
Dim foldername, folderobj
Dim subfolders
Dim sourcedrive, destdrive
Dim endmessage

'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' sourcedrive = Drive letter to copy from
' destdrive = Drive letter to copy to
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
sourcedrive="c"
destdrive="d"
foldername = ""

sourcedrive=UCase(Left(sourcedrive,1)) & ":\"
destdrive=UCase(Left(destdrive,1)) & ":\"

Set driveobj=CreateObject("Scripting.FileSystemObject")
Set folderobj=driveobj.GetFolder(sourcedrive & foldername)
Set subfolders=folderobj.SubFolders
Set fileset=folderobj.Files

DoCopy subfolders, fileset, foldername

Set driveobj=Nothing
Set folderobj=Nothing
Set subfolders=Nothing
Set fileset=Nothing

endmessage = "Back Up Finished"

MsgBox endmessage

'End of program


Sub DoCopy(subfolder, files, foldername)

Dim onefolder, newfoldername
Dim onefile, fileset
Dim destfoldername
Dim sourcefilename, destfilename, destfile, destfileobj
Dim fileattributes, system, readonly, hidden

'if folder does not exist on destination drive,
' create it and continue
Set destfileobj=CreateObject("Scripting.FileSystemObject")

If Not destfileobj.FolderExists(destdrive & foldername) Then
  destfileobj.CreateFolder destdrive & foldername
End If

'go to lowest subfolder first
For Each onefolder in subfolder
  newfoldername = LCase(foldername & onefolder.name & "\")
  Set folderobj=driveobj.GetFolder(sourcedrive & newfoldername)
  Set subfolders=folderobj.SubFolders
  Set fileset=folderobj.Files
  DoCopy subfolders, fileset, newfoldername
Next

'if no more subfolders, then go through files
For Each onefile in files
  sourcefilename = sourcedrive & foldername & onefile.name
  destfilename = destdrive & foldername & onefile.name

  'if the destination file doesn't exist,
  'then copy the sourcefile to the destination folder
  If Not destfileobj.FileExists(destfilename) Then
    On Error Resume Next
    onefile.Copy destfilename
    On Error GoTo 0
    filecount = filecount + 1
  'if the destination file already exists
  Else
    Set destfile=destfileobj.GetFile(destfilename)
    
    'then check to see if the source file's last modified date
    'is newer than the destination file.  If it is,
    'then overwrite the destination file with the source file
    If onefile.DateLastModified > destfile.DateLastModified Then
      'turn all file attributes off to copy updated file over older one
      destfile.Attributes = 0
      On Error Resume Next
      onefile.Copy destfilename, True
      On Error GoTo 0
      filecount = filecount + 1
    End If
    Set destfile=Nothing
  End If
Next

Set folderobj=Nothing
Set subfolders=Nothing
Set fileset=Nothing
Set destfileobj=Nothing

End Sub

Lee

 

[smurfhell]

Alright, here's what I've come up with, but I still need a little help or any advice.

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colFiles = objWMIService. _
    ExecQuery("Select * from CIM_DataFile where Extension = 'bak'")

For Each objFile in colFiles
    strCopy = "C:\fakemove\" & objFile.FileName _
        & "." & objFile.Extension
    objFile.Copy(strCopy)
    objFile.Delete
Next
msgbox("Complete")

Unfortunately, this searches the entire computer including mapped drives....not good if you have every share on the network mapped. I now have over 1000 *.bak files on my computer.

How would I limit this to search only a specific folder and subfolders?

 

[trollacious]

Filter out the files where the objFile drive is one of the mapped drives with an If statement, and only process the files that aren't on those drives. If the Object you're using doesn't have that property, then you'll have to use another object that does.

Lee

 

[tsuji]

smurfhell,

[1] Why do you want to do it with wmi? cim_datafile is monstrously hugh thing.

[2] In the way you do with extension, this is what you should expect. Where is the info of the root? how would the service know?

[3] If you specify the drive and path (this is necessary), the search will not be done recursively. You must device the similar call and use assocquery.

- tsuji

 

[mrmovie]

'i think this is as sort as you can get it

strDir = "f:\"
Set objDir = FSO.GetFolder(strDir)
getInfo(objDir)

Function getInfo(pCurrentDir)

For Each aItem In pCurrentDir.Files
'wscript.Echo aItem.Name
If LCase(Right(Cstr(aItem.Name), 3)) = "bak" Then
'do file manip, copy delete here
End If
Next

For Each aItem In pCurrentDir.SubFolders
'wscript.Echo aItem.Name & " passing recursively"
getInfo(aItem)
Next

End Function

 

[mrmovie]

maybe it should be a sub!

 

[smurfhell]

Ok people, here is what I've come up with so far. This script uses WMI and moves all *.bak files from D:\Projects and subdirectories to D:\Backup.

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colFiles = objWMIService. _
    ExecQuery("Select * from CIM_DataFile where Drive= 'D:' " _
& "AND Path = '\\projects\\' " _
& "AND Extension = 'bak'")

For Each objFile in colFiles
    strCopy = "D:\backup\" & objFile.FileName _
        & "." & objFile.Extension
    objFile.Copy(strCopy)
    objFile.Delete
Next
msgbox("Complete")

I'm still working on a script that uses FSO but I'm currently stuck on my "If...Then" statement. I'll post something when I get it figured out.

 

[smurfhell]

Oops, I posted the wrong code.

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colFiles = objWMIService. _
    ExecQuery("Select * from CIM_DataFile where Drive= 'F:' " _
& "AND Extension = 'bak'")

For Each objFile in colFiles
    strCopy = "D:\backup\" & objFile.FileName _
        & "." & objFile.Extension
    objFile.Copy(strCopy)
    objFile.Delete
Next
msgbox("Complete")

I have F: mapped to the folder that contains all the subfolders I want to scan. Not the most efficient method, but it works right now until I find/create an alternative.

 

[smurfhell]

Ok, my previous code didn't work...possibly because it can't search a mapped drive. I have now written another WMI script that does a recursive search, thanks to the help of this article :

http://blogs.msdn.com/gstemp/archive/2004/08/11.aspx

strComputer = "."
strDrive = "d:"
strPath = "projects" 'Use double backslashes in path if necessary
strPathAlt = Replace(strPath, "\\", "\")
strName = strDrive & "\" & strPathAlt
Set objWMIService = GetObject("winmgmts:\\" & strComputer)


Set colFiles = objWMIService.ExecQuery _
 ("SELECT * FROM CIM_DataFile WHERE Drive = '" & strDrive & _
 "' AND Path = '\\" & strPath & "\\'" _
& "AND Extension='bak'")

For Each objFile in colFiles
  
strcopy = "d:\backup\bakfiles\" & objFile.Filename _
& "." & objFile.Extension
objFile.Copy(strCopy)
objFile.Delete

Next

Set colFolders = objWMIService.ExecQuery _
 ("ASSOCIATORS OF {Win32_Directory.Name='" & strName & "'} " _
 & "WHERE AssocClass = Win32_Subdirectory " _
 & "ResultRole = PartComponent")

For Each objFolder in colFolders

  strFolderPath = Replace(objFolder.Path, "\", "\\")
  strFilePath = strFolderPath & objFolder.FileName & "\\"
  Set colFiles = objWMIService.ExecQuery _
   ("SELECT * FROM CIM_DataFile WHERE Drive = '" & strDrive & _
   "' AND Path = '" & strFilePath & "'" _
& "AND Extension='bak'")

  For Each objFile in colFiles

strcopy = "d:\backup\bakfiles\" & objFile.Filename _
& "." & objFile.Extension
objFile.Copy(strCopy)
objFile.Delete

  Next

  ShowSubFolders objFolder.Name

Next

Sub ShowSubFolders(strSubFolder)

Set colSubFolders = objWMIService.ExecQuery _
 ("ASSOCIATORS OF {Win32_Directory.Name='" & strSubFolder & "'} " _
 & "WHERE AssocClass = Win32_Subdirectory " _
 & "ResultRole = PartComponent")

For Each objSubFolder in colSubFolders

  strSubFolderPath = Replace(objSubFolder.Path, "\", "\\")
  strSubFilePath = strSubFolderPath & objSubFolder.FileName & "\\"
  Set colSubFiles = objWMIService.ExecQuery _
   ("SELECT * FROM CIM_DataFile WHERE Drive = '" & strDrive & _
   "' AND Path = '" & strSubFilePath & "'" _
& "AND Extension='bak'")

  For Each objSubFile in colSubFiles

strcopy = "d:\backup\bakfiles\" & objSubFile.Filename _
& "." & objSubFile.Extension
objSubFile.Copy(strCopy)
objSubFile.Delete

  Next

  ShowSubFolders objSubFolder.Name

Next

End Sub

msgbox "Complete"

 

[smurfhell]

Ok, I've finally completed my FSO script. It successfully scanned 222,361 folders (835,000 files) in 30 minutes. I added a bit to the script to tell me what time it completed. Thanks for all of your help and feel free to use or steal parts of this script:

Dim objFSO, objFolder, colFiles, objSubFolder, objSubFile
strFolder = "d:\projects"
strTar = "d:\backup\bakfiles\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)
Set colFiles = objFolder.Files

For Each File in colFiles
set objFile = objFSO.GetFile(strFolder & "\" & File.Name)
Next

If lcase(Right(objFile.Name,3)) = "bak" Then
objFSO.CopyFile objFile,(strTar)
objFSO.DeleteFile objFile, true
End If

ScanSubFolders(objFolder)

Sub ScanSubFolders(objFolder)

Set colFolders = objFolder.SubFolders
For Each objSubFolder In colFolders


Set colFiles = objSubFolder.Files
For Each objFile in Colfiles
If lcase(Right(objFile.Name,3)) = "bak" Then
objFSO.CopyFile objFile,(strTar)
objFSO.DeleteFile objFile, true
End If
Next
ScanSubFolders(objSubFolder)
Next
End Sub

strComputer="."
set objWMIService = GetObject("winmgmts:\\" & strComputer)
     Set colOperatingSystems = objWMIService.ExecQuery _
         ("Select * from Win32_OperatingSystem")

     For Each objOS in colOperatingSystems
         dtmLastBootUpTime = ConvWMIDateTime(objOS.LocalDateTime, "ISO8601")
         Wscript.Echo "Completed at " & dtmLastBootUpTime
         Next

Function ConvWMIDateTime(sDMTFformat, iNamedFormat)

   Dim sYear, sMonth, sDay, sHour, sMinutes, sSeconds
   sYear = mid(sDMTFformat, 1, 4)
   sMonth = mid(sDMTFformat, 5, 2)
   sDay = mid(sDMTFformat, 7, 2)
   sHour = mid(sDMTFformat, 9, 2)
   sMinutes = mid(sDMTFformat, 11, 2)
   sSeconds = mid(sDMTFformat, 13, 2)

   ConvWMIDateTime = sHour & ":" & sMinutes & ":" & sSeconds & " " _
                & sMonth & "-" & sDay & "-" & sYear

   If IsNumeric(iNamedFormat) Then
     If iNamedFormat >= 0 And iNamedFormat <= 4 Then
       ' FormatDateTime will set date format to specified format
       ConvWMIDateTime = FormatDateTime(ConvWMIDateTime, iNamedFormat)
     End If
   End If
End Function