5 Replies - 5284 Views - Last Post: 29 April 2011 - 06:37 AM Rate Topic: -----

#1 j_rod722   User is offline

  • D.I.C Head

Reputation: 0
  • View blog
  • Posts: 53
  • Joined: 25-January 11

subfolder recursion

Posted 08 April 2011 - 11:15 AM

i am trying to get this script to jump into a directory and copy all files and subdirectories and their files, lines 45-80 is where i am having issues. i am not getting an error but it only copies the first subdirectory. it does not go back and copy the next subdirectory. any suggestions?

Dim FSO, goodMsg, badMsg, strFingerPrint1, strFingerPrint2, subFolderName

objStartFolder = "C:\Users\jdowell\Desktop\A\"
objEndFolder = "C:\Users\jdowell\Desktop\B\"
strLogLocation = "C:\"
strScript = Wscript.ScriptName
strLogName = Left(strScript, Len(strScript)-4) & "Log.txt"
emailRecp = "[email protected]"
emailFrom = "[email protected]"

Set FSO = CreateObject("scripting.FileSystemObject")
Set objEmail = CreateObject("CDO.Message")
Set objFolder = FSO.GetFolder(objStartFolder)
Set objShell = WScript.CreateObject("WScript.Shell")
Set objLogFile = FSO.OpenTextFile(strLogLocation & strLogName, 8, True)

WScript.echo "Starting"
''''''''''''''''''''''''''''
' LOGS THAT SCRIPT STARTED '
''''''''''''''''''''''''''''
strMsg = "Starting Transfer from: " +  objStartFolder
objLogFile.WriteLine(Now & vbTab & strMsg)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CHECKS TO SEE IF THERE ARE ANY FILES THAT HAVE BEEN UPLOADED '
' VERIFIES THE FILES HAVE FINISHED UPLOADING, COPIES FILES     '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
if FSO.GetFolder(objStartFolder).Files.Count > 0 or FSO.GetFolder(objStartFolder).SubFolders.Count > 0 then
WScript.echo "CheckPoint 1: Checked for files"
    Set colFiles = objFolder.Files
	For Each objFile in colFiles
	On Error Resume Next
	Err.Clear
		If objFile.Name <> "" then
			strFingerPrint1 = MD5Hash(objStartFolder + objFile.Name)
			WScript.Sleep(1000)
			strFingerPrint2 = MD5Hash(objStartFolder + objFile.Name)
			DO UNTIL strFingerPrint1 = strFingerPrint2
				WScript.Sleep(1000)
				strFingerPrint2 = MD5Hash(objStartFolder + objFile.Name)
			LOOP
			FSO.CopyFile objStartFolder +"*", objEndFolder, true
		End If
	Next
	WScript.echo "CheckPoint 2: copied files, checking for subfolders"
	
	ShowSubfolders FSO.GetFolder(objStartFolder)
	Sub ShowSubFolders(Folder)
		
		For Each Subfolder in Folder.SubFolders 
		Set objFolder = FSO.GetFolder(Subfolder.Path)
		Set colFolders = Folder.SubFolders
		
		subFolderName = Replace(objFolder, objStartFolder, "")
		
		WScript.echo "CheckPoint 3: deciding if subfolders exist" 
		If FSO.FolderExists(objEndFolder + subFolderName) Then
			FSO.CopyFile Subfolder + "\*", objEndFolder + subFolderName, true
			WScript.echo "true: subfolder exists, files copied"
			Else
			FSO.CreateFolder(objEndFolder + subFolderName)
			FSO.CopyFile Subfolder + "\*", objEndFolder + subFolderName, true
			WScript.echo "false: subfolder doesn't exist, created and copied files"
		End if
			
			For Each objFile in colFiles
				if objFile.Name <> "" then
					'strFingerPrint1 = MD5Hash(objStartFolder + objFile.Name)
					WScript.Sleep(1000)
					'strFingerPrint2 = MD5Hash(objStartFolder + objFile.Name)
					'DO UNTIL strFingerPrint1 = strFingerPrint2
						WScript.Sleep(1000)
						'strFingerPrint2 = MD5Hash(objStartFolder + objFile.Name)
					'LOOP
					FSO.CopyFile Subfolder + "*", objEndFolder + subFolderName, true
				End If
			Next
			ShowSubFolders Subfolder
		Next
	End Sub
	WScript.echo "CheckPoint 4: all Subfolders created and files copied"
	''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
	' RECURSES & LISTS ALL FILES IN DIRECTORY AND SUBDIRECTORIES '
	' CHECKSUMS FILES, LOGS MSG AND OUTCOME                      '
	''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
	Set colFiles = objFolder.Files
	For Each objFile in colFiles
		if objFile.Name <> "" then
			strFingerPrint1 = MD5Hash(objStartFolder + objFile.Name)
			strFingerPrint2 = MD5Hash(objEndFolder + objFile.Name)
			If strFingerPrint1 = strFingerPrint2 Then
				goodMsg = goodMsg + objFile.Name & vbNewLine
				strMsg = "Successful Transfer: " + objFile.Name 
				objLogFile.WriteLine(Now & vbTab & strMsg)					
				Else
				badMsg = badMsg + objFile.Name & vbNewLine
				strMsg = "Failure: " + objFile.Name 
				objLogFile.WriteLine(Now & vbTab & strMsg)
			End If
		End if
	Next

	ShowSubfolders2 FSO.GetFolder(objStartFolder)

	Sub ShowSubFolders2(Folder)
		For Each Subfolder in Folder.SubFolders
			Set objFolder = FSO.GetFolder(Subfolder.Path)
			Set colFiles = objFolder.Files
			For Each objFile in colFiles
				if objFile.Name <> "" then
					strFingerPrint1 = MD5Hash(objStartFolder + objFile.Name)
					strFingerPrint2 = MD5Hash(objEndFolder + objFile.Name)
					If strFingerPrint1 = strFingerPrint2 Then
						goodMsg = goodMsg + objFile.Name & vbNewLine
						strMsg = "Successful Transfer: " + objFile.Name 
						objLogFile.WriteLine(Now & vbTab & strMsg)
						Else
						badMsg = badMsg + objFile.Name & vbNewLine
						strMsg = "Failure: " + objFile.Name 
						objLogFile.WriteLine(Now & vbTab & strMsg)
					End If
				End if
			Next
			ShowSubFolders2 Subfolder
		Next
	End Sub
	WScript.echo "CheckPoint 5: Copied Files verified "

	If goodMsg <> "" Then
		'''''''''''''''''''''''''''''''''''''''''''''
		' EMAILS RECIPIENT THAT THERE ARE NEW FILES '
		'''''''''''''''''''''''''''''''''''''''''''''
		objEmail.From = emailFrom 
		objEmail.To = emailRecp
		objEmail.Subject = "New UES Files"
		objEmail.Textbody = "You have new UES files in your directory: " + objEndFolder & vbNewLine & vbNewLine + goodMsg & vbNewLine + "Please let IT know if there are any issues. Thanks."
		objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
		objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.ugacinc.com"
		objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
		objEmail.Configuration.Fields.Update
		objEmail.Send
		strMsg = "Emailed: " + emailRecp
		objLogFile.WriteLine(Now & vbTab & strMsg)
		strMsg = "Finished Successfully"
		objLogFile.WriteLine(Now & vbTab & strMsg)
	end if
	If badMsg <> "" Then
		'''''''''''''''''''''''
		' EMAILS ERRORS TO IT '
		'''''''''''''''''''''''
		objEmail.From = emailFrom
		objEmail.To = "[email protected]"
		objEmail.Subject = "ERROR"
		objEmail.Textbody = "There was an error transferring files: " & vbNewLine & vbNewLine + badMsg & vbNewLine + "Please research."
		objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
		objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.ugacinc.com"
		objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
		objEmail.Configuration.Fields.Update
		objEmail.Send
		strMsg = "Emailed: IT"
		objLogFile.WriteLine(Now & vbTab & strMsg)
		strMsg = "Finished with Errors"
		objLogFile.WriteLine(Now & vbTab & strMsg)
	Else
	FSO.DeleteFile objStartFolder +"*"
	'FSO.DeleteFolder objStartFolder +"*"
	WScript.echo "CheckPoint 6: Notifications emailed, original files deleted"
	End if
End if
'''''''''''''''''''''
' LOGS SCRIPT ENDED '
'''''''''''''''''''''
objLog.Close

Set objLogFile = Nothing
Set FSO = Nothing
Set objShell = Nothing
WScript.echo "Finished"
Public Function MD5Hash(sFileName)
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com

  Const OpenAsDefault = -2
  Const FailIfNotExist = 0
  Const ForReading = 1
 
  Dim oMD5CmdShell, oMD5CmdFSO, sTemp, sTempFile, fMD5CmdFile, sPath
  Dim fResultsFile, sResults

  Set oMD5CmdShell = CreateObject("WScript.Shell")
  Set oMD5CmdFSO = CreateObject("Scripting.FileSystemObject")
  sTemp = oMD5CmdShell.ExpandEnvironmentStrings("%TEMP%")
  sTempFile = sTemp & "\" & oMD5CmdFSO.GetTempName
 
  '------Verify Input File Existance-----
  If Not oMD5CmdFSO.FileExists(sFileName) Then
    MD5Hash = "Failed: Invalid Input File."
  Else
    Set fMD5CmdFile = oMD5CmdFSO.GetFile(sFileName)
    sPath = fMD5CmdFile.ShortPath
    sFileName = sPath
    Set fMD5CmdFile = Nothing
  End If
  '--------------------------------------
 
  oMD5CmdShell.Run "%comspec% /c md5.exe -n " & sFileName & _
  " > " & sTempFile, 0, True

  Set fResultsFile = _
  oMD5CmdFSO.OpenTextFile(sTempFile, ForReading, FailIfNotExist, OpenAsDefault)
  sResults = fResultsFile.ReadAll
  sResults = trim(Replace(sResults, vbCRLF,""))
  fResultsFile.Close
  oMD5CmdFSO.DeleteFile sTempFile
 
  If len(sResults) = 32 And IsHex(sResults) Then
    MD5Hash = sResults
  Else
    MD5Hash = "Failed."
  End If
 
  Set oMD5CmdShell = Nothing
  Set oMD5CmdFSO = Nothing
End Function

Private Function IsHex(sHexCheck)
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com

  Dim sX, bCharCheck, sHexValue, sHexValues, aHexValues
  sHexCheck = UCase(sHexCheck)
  sHexValues = "0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F"
  aHexValues = Split(sHexValues, ",")

  For sX = 1 To Len(sHexCheck)
    bCharCheck = False
    For Each sHexValue In aHexValues
      If UCase(Mid(sHexCheck,sX,1)) = sHexValue Then
        bCharCheck = True
        Exit For
      End If
    Next
   
    If bCharCheck <> True Then
      IsHex = False
      Exit Function
    End If
  Next
 
  IsHex = True
End Function



Is This A Good Question/Topic? 0
  • +

Replies To: subfolder recursion

#2 chuckjessup   User is offline

  • D.I.C Regular

Reputation: 34
  • View blog
  • Posts: 380
  • Joined: 26-October 09

Re: subfolder recursion

Posted 08 April 2011 - 03:42 PM

Hey,

I have in the past had issues with the "for each" statement in the past, It looks like the error catch is to resume next...

You may be getting an error in the processing of the code and dont know it. Try first to comment out the On Error Resume Next, This will show errors in the for each folder.subfolder line... I think thats one issue...

I like using arrays, they seem to work for me... You can do this by, doing several ways of getting the number of directories in the folder, then add there paths to the array, then iterate through the array and have that deal with each folder, something i believe like this...:
Private Sub SubFolders(ParentFolder as Folder)
    'You will need to collect the number of folders in the parent directory... i will leave that to you...'
    'The way that you would declare the array because each parent folder has varing number of subfolders.'
dim SubFolders() as string 'I am not sure if you can use Folder as a type decl. its very possible.'
    'Now you need to set the number of spaces in the array to assign, Use the method of getting number of sub folders.'
    'If you add one folder at a time you will want to use the preserve command...'
redim SubFolders(X) 'We dont need to add the as string to this line its been done already.'
    'Now we will use a For...Next loop to iterate through the folders in the array.'
dim I as integer 'for the for loop'
for I = 0 to X
    'Here go through the copy command, which ever you choose...'
Next I

    'The rest of your code... I recommend this as it is clearer of what you seem to be wanting to get done.'



You also need to look at your sub declaration, Typically you need to decare variants for the code to work properly.
example:
    'Instead of using:'
Private Sub SubFolders(ObjectFolder)
    'doing the above declares as a Variant, Which is not good for coding, and will likely raise comments, and issues...'
    'Try telling VB what the variable is... such as the following.'
Private Sub SubFolders(ObjectFolder As Folder)
    'This may be the reason the code is hanging, But you have to see what the errors if any are being raised.'



If you post the code again, Please post the code segment that you are having issues with, It helps see whats going on...
Also if you would let us know what it is or is not doing so we can better help you.

Jesse Fender
Was This Post Helpful? 0
  • +
  • -

#3 BobRodes   User is offline

  • Product Manager
  • member icon

Reputation: 604
  • View blog
  • Posts: 3,085
  • Joined: 19-May 09

Re: subfolder recursion

Posted 09 April 2011 - 03:42 PM

jrod, here's a simple example: http://www.cruto.com...g-Recursion.asp
Was This Post Helpful? 0
  • +
  • -

#4 j_rod722   User is offline

  • D.I.C Head

Reputation: 0
  • View blog
  • Posts: 53
  • Joined: 25-January 11

Re: subfolder recursion

Posted 12 April 2011 - 12:17 PM

after commenting out the "on error resume" i get this error. the folder structure is folder>folder>file. it is line 3 on this snippet

line: 173
char: 3
error: input past end of file
code:800a003e
Set fResultsFile = _
  oMD5CmdFSO.OpenTextFile(sTempFile, ForReading, FailIfNotExist, OpenAsDefault)
  sResults = fResultsFile.ReadAll
  sResults = trim(Replace(sResults, vbCRLF,""))
  fResultsFile.Close
  oMD5CmdFSO.DeleteFile sTempFile


This post has been edited by j_rod722: 12 April 2011 - 12:30 PM

Was This Post Helpful? 0
  • +
  • -

#5 j_rod722   User is offline

  • D.I.C Head

Reputation: 0
  • View blog
  • Posts: 53
  • Joined: 25-January 11

Re: subfolder recursion

Posted 12 April 2011 - 12:50 PM

why does this only recurse if there is a file in the first directory? if there is no file in the first directory and just subfolders it errors out at the same line of code as in the post above this one:

	Set colFiles = objFolder.Files
	For Each objFile in colFiles
		if objFile.Name <> "" then
			strFingerPrint1 = MD5Hash(objStartFolder + objFile.Name)
			strFingerPrint2 = MD5Hash(objEndFolder + objFile.Name)
			If strFingerPrint1 = strFingerPrint2 Then
				goodMsg = goodMsg + objFile.Name & vbNewLine
				strMsg = "Successful Transfer: " + objFile.Name 
				objLogFile.WriteLine(Now & vbTab & strMsg)					
				Else
				badMsg = badMsg + objFile.Name & vbNewLine
				strMsg = "Failure: " + objFile.Name 
				objLogFile.WriteLine(Now & vbTab & strMsg)
			End If
		End if
	Next

	ShowSubfolders2 FSO.GetFolder(objStartFolder)

	Sub ShowSubFolders2(Folder)
		For Each Subfolder in Folder.SubFolders
			Set objFolder = FSO.GetFolder(Subfolder.Path)
			Set colFiles = objFolder.Files
			For Each objFile in colFiles
				if objFile.Name <> "" then
					'strFingerPrint1 = MD5Hash(objStartFolder + objFile.Name)
					'strFingerPrint2 = MD5Hash(objEndFolder + objFile.Name)
					If strFingerPrint1 = strFingerPrint2 Then
						goodMsg = goodMsg + objFile.Name & vbNewLine
						strMsg = "Successful Transfer: " + objFile.Name 
						objLogFile.WriteLine(Now & vbTab & strMsg)
						Else
						badMsg = badMsg + objFile.Name & vbNewLine
						strMsg = "Failure: " + objFile.Name 
						objLogFile.WriteLine(Now & vbTab & strMsg)
					End If
				End if
			Next
			ShowSubFolders2 Subfolder
		Next
	End Sub
	WScript.echo "CheckPoint 5: Copied Files verified "


This post has been edited by j_rod722: 12 April 2011 - 12:51 PM

Was This Post Helpful? 0
  • +
  • -

#6 BobRodes   User is offline

  • Product Manager
  • member icon

Reputation: 604
  • View blog
  • Posts: 3,085
  • Joined: 19-May 09

Re: subfolder recursion

Posted 29 April 2011 - 06:37 AM

I'm unable to reproduce the behavior you describe, using this code in VB6:
Option Explicit
Dim fso As FileSystemObject

Private Sub Command1_Click()
Set fso = New FileSystemObject
ShowSubFolders2 fso.GetFolder("C:\Temp2")
End Sub

Sub ShowSubFolders2(myFolder)
Dim objFolder As Folder
Dim objFile As File
On Error GoTo ErrHandle
For Each objFolder In myFolder.SubFolders
    Debug.Print objFolder.Path
    For Each objFile In objFolder.Files
        Debug.Print objFile.Name
    Next
    On Error GoTo 0
    ShowSubFolders2 objFolder
Next
Exit Sub
ErrHandle:
If Err.Number = 70 Then 'Skip folders with permission denied
    Err.Clear
    Exit Sub
Else
    Err.Raise Err.Number
End If
End Sub

This code worked fine on C:\Program Files. I created a test folder set under c:\Temp2, with these results:
C:\Temp2\New folder
C:\Temp2\New folder (2)
test1.txt
As you can see, New folder has no files in it, and New folder (2) has one file in it. I got no errors. Perhaps you can examine my code, which represents a simplification of yours, and see if you can get yours working. First strip out any non-essential code, especially unnecessary variables.

This post has been edited by BobRodes: 29 April 2011 - 06:40 AM

Was This Post Helpful? 0
  • +
  • -

Page 1 of 1