VBScript FileSystemObject for copyfile.

Hello experts,

I am using the following VBScript code in Visual Builder to find a file recursively in a folder and then copy it to a different location. I am unable to understand how I can check if a File is not found in thie piece of code.

Any ideas or suggestions will be appreciated.


'Search the main folder for a given file and copy from source to destination
Sub ScanFolders(objFolder,VarName)
      Set colFiles = objFolder.Files
      For Each objFile in colFiles
            if objFile.Name = VarName then
                FSO.CopyFile objFolder.Path & "\" & VarName, objDestFolder & "\" , true
                builder.LogMessage VarName & " copied from" & objFolder.Path & " to" & " - %DestinationDir%",true
          end if
      Next
      ShowSubfolders objFSO.GetFolder(objStartFolder),VarName
End Sub

'Search the subfloders recursively and copy the file from source to destination
Sub ShowSubFolders(Folder,VarName)
      'MsgBox "Folder being searched: " & Folder.Path & " File is: " & Varname
      For Each Subfolder in Folder.SubFolders
        Set objectFolder = objFSO.GetFolder(Subfolder.Path)
        Set colFiles = objectFolder.Files
        For Each objFile in colFiles              
            if objFile.Name = VarName then
                     'MsgBox "File found:" & VarName
                     'MsgBox "Source is: " & Subfolder.Path & "\" & VarName
                'MsgBox "Dest is: " & objDestFolder & "\"
                  FSO.CopyFile Subfolder.Path & "\" & VarName, objDestFolder & "\", true       
                  builder.LogMessage VarName & " copied from - " & SubFolder.Path & " to" & " - %DestinationDir%",true
            end if
        Next
        ShowSubFolders Subfolder,VarName
      Next
      
End Sub

Thanks.

jaiswalpragyaAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

JesterTooCommented:
Three questions and a couple of observations:

Q1.  Can the filename exist in more than one of these folders and what do you want to do if it does? (your code would continue thru all folders and perform the copy each time it finds the file leaving only the last one in the destination folder)

Q2.  If the filename is not found in any folder do you just want a simple msgbox stating that?

Q3.  Both of these subroutines can be combined into a single sub to simplify the script... do you want that?

Lynn
jaiswalpragyaAuthor Commented:
Thanks for the response.

1. The filenames exist in only one of the subfolders.
2.If the filename is not found i  will be logging message to the Visual builder, which you could say is like a MsgBox stating that.
3. Yes, a single subroutine would be a better option.

Thanks.
JesterTooCommented:
OK, here is the script... let me know if it works for you.

Regards,
Lynn


Option Explicit

Dim SearchFileName    :  SearchFileName = "FileName.ext"
Dim SearchPath        :  SearchPath     = "E:\EE\Source\"
Dim DestPath          :  DestPath       = "E:\EE\Destination\"
Dim oFso
Dim oFile
Dim oFolder, oSubFolder
Dim StopNow           :  StopNow   = False
Dim FoundFile         :  FoundFile = False
Dim lcSearchFileName  :  lcSearchFileName = LCase(SearchFileName)

Set oFso = CreateObject("Scripting.FileSystemObject")

'-- determine if directory structures exist...
If Right(SearchPath,1) <> "\" Then SearchPath = SearchPath & "\"
If Not oFso.FolderExists(SearchPath) Then
   Wscript.Echo "Source path is invalid."
   StopNow = True
End If

If Right(DestPath,1) <> "\" Then DestPath = DestPath & "\"
If Not oFso.FolderExists(DestPath) Then
   Wscript.Echo "Destination path is invalid."
   StopNow = True
End If

If StopNow Then
   Wscript.Echo "Terminating due to error(s)."
   Wscript.Quit(16)
End If

Call DirWalk(SearchPath)

If Not FoundFile Then
   Wscript.Echo "Failed to find the file: " & SearchFileName & " within the folder tree: " & SearchPath
   Wscript.Quit(4)
End If

Set oFile = Nothing
Set oSubFolder = Nothing
Set oFolder = Nothing
Set oFso = Nothing


Sub DirWalk(Path)

   '-- We'll handle any errors ourself, thank you very much
   '-- Note:  This is REQUIRED if either SearchPath or DestPath is the root
   '--        of a volume.
   '--
   On Error Resume Next

   Set oSubFolder = oFso.getFolder(Path)

   For Each oFile In oSubFolder.Files
      If Err.Number = 0 Then
         If LCase(oFile.Name) = lcSearchFileName Then
            oFile.Copy DestPath & oFile.Name, False
            FoundFile = True
            Exit Sub
         End If

      Else
         '-- if we got an error, just skip this entry... the Volume Label appears
         '-- as a folder in the root of each volume and is not accessible.
         Err.Clear
      End If
   Next

   For Each oFolder In oSubFolder.SubFolders
      DirWalk oFolder.Path      '-- recurse the DirWalk sub with the subdir paths
   Next

   On Error Goto 0              '-- Resume letting system handle errors.

End Sub

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Introduction to R

R is considered the predominant language for data scientist and statisticians. Learn how to use R for your own data science projects.

jaiswalpragyaAuthor Commented:
Thanks for the script. But my script has to copy multiple files by looping. The files to be copied are retrieved from a database and then searched and copied. Here is my whole code:

builder.LogMessage "Total rows selected from PLTSBuilds.mdb : " & vbld_TempMacroObj("ADO_RS").Recordcount

'Set File system Objects
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set FSO = CreateObject("Scripting.FileSystemObject")

'Define the Source and detsination directory
objStartFolder = "%SourceDir%"
objDestFolder = "%DestinationDir%"
Set objFolder = objFSO.GetFolder(objStartFolder)

'Move to the first record in the Temporary Recordset
vbld_TempMacroObj("ADO_RS").movefirst

'Loop through all the records in record set
Do until vbld_TempMacroObj("ADO_RS").eof
      
          ' Get the file name from
            fname = vbld_TempMacroObj("ADO_RS").Fields("FileName")
            n = Len(fname)
            
            'Get file name without any extension
            CropStr = Left(fname,n-4)
            
            'Process File name
             ScanFolders objFolder,fname      
            
            'Process PDB
            if vbld_TempMacroObj("ADO_RS").Fields("PDB") = True then
                  PdbStr = CropStr & ".pdb"
                  MsgBox PdbStr
                  ScanFolders objFolder,PdbStr
            end if
            
            'Process RegFile            
            if vbld_TempMacroObj("ADO_RS").Fields("RegFile") = True then
                  RegStr = CropStr & ".reg"
                  MsgBox RegStr
                  ScanFolders objFolder,RegStr
            end if
            
            'Process ResourceDLL
             if vbld_TempMacroObj("ADO_RS").Fields("ResourceDLL") = True then
                  ResStr = CropStr & ".RES"
                  MsgBox ResStr
                  ScanFolders objFolder,ResStr
            end if
            
             'Process OtherFiles
             if vbld_TempMacroObj("ADO_RS").Fields("OtherFiles") <> "" then
                    OFStr = vbld_TempMacroObj("ADO_RS").Fields("OtherFiles")
                   Dim i,a
                   'Define the delimiter
                   Seps = ","
                   'Call function to tokenize
                  a = Tokenize(OFStr,Seps)                   
                   For i=1 to UBound(a)
                         ScanFolders objFolder,a(i-1)
                   Next
            end if
                  
            vbld_TempMacroObj("ADO_RS").movenext
Loop

'Function to tokenize "OtherFiles"
Function Tokenize(byVal TokenString, byVal TokenSeparator)

      Dim NumWords, a()
      NumWords = 0
      
            
      Do
            Dim SepIndex, SepPosition
            SepPosition = 0
            SepIndex    = -1
            
                  ' Find location of separator in the string
                  Dim pos
                  pos = InStr(TokenString, TokenSeparator)
                  
                  ' Is the separator present, and is it closest to the beginning of the string?
                  If pos > 0 and ( (SepPosition = 0) or (pos < SepPosition) ) Then
                        SepPosition = pos
                        SepIndex    = i
                  End If
                  
            
            ' Did we find any separators?      
            If SepIndex < 0 Then

                  ' None found - so the token is the remaining string
                  redim preserve a(NumWords+1)
                  a(NumWords) = TokenString
                  
            Else

                  ' Found a token - pull out the substring            
                  Dim substr
                  substr = Trim(Left(TokenString, SepPosition-1))
      
                  ' Add the token to the list
                  redim preserve a(NumWords+1)
                  a(NumWords) = substr
            
                  ' Cutoff the token we just found
                  Dim TrimPosition
                  TrimPosition = SepPosition+Len(TokenSeparator)
                  TokenString = Trim(Mid(TokenString, TrimPosition))
                                    
            End If      
            
            NumWords = NumWords + 1
      loop while (SepIndex >= 0)
      
      Tokenize = a
      
End Function
                  
'Search the main folder for a given file and copy from source to destination
Sub ScanFolders(objFolder,VarName)
      Set colFiles = objFolder.Files
      For Each objFile in colFiles
            if objFile.Name = VarName then
                FSO.CopyFile objFolder.Path & "\" & VarName, objDestFolder & "\" , true
                builder.LogMessage VarName & " copied from" & objFolder.Path & " to" & " - %DestinationDir%",true
          end if
      Next
      ShowSubfolders objFSO.GetFolder(objStartFolder),VarName
End Sub

'Search the subfloders recursively and copy the file from source to destination
Sub ShowSubFolders(Folder,VarName)
      'MsgBox "Folder being searched: " & Folder.Path & " File is: " & Varname
      For Each Subfolder in Folder.SubFolders
        Set objectFolder = objFSO.GetFolder(Subfolder.Path)
        Set colFiles = objectFolder.Files
        For Each objFile in colFiles              
            if objFile.Name = VarName then
                     'MsgBox "File found:" & VarName
                     'MsgBox "Source is: " & Subfolder.Path & "\" & VarName
                'MsgBox "Dest is: " & objDestFolder & "\"
                  FSO.CopyFile Subfolder.Path & "\" & VarName, objDestFolder & "\", true       
                  builder.LogMessage VarName & " copied from - " & SubFolder.Path & " to" & " - %DestinationDir%",true
            end if
        Next
        ShowSubFolders Subfolder,VarName
      Next
      
End Sub

In the script you gave me, it copies one file and then exits. Also, the FoundFile and StopNow conditions are set once a file is found.

Thanks.
jaiswalpragyaAuthor Commented:
Hey thanks, I changed it accordingly. Its working fine.

JesterTooCommented:
I'm glad you were able to use it.  

Had you stated in your original question that which you explained in your recent comment I would have presented a solution you didn't need to modify :)  Only 3 or 4 minor changes would be necessary to accomodate that.

Thanks for the grade!

Regards,
Lynn
jaiswalpragyaAuthor Commented:
Thanks!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Programming

From novice to tech pro — start learning today.