Question : VBscript to search subfolders and copy files

Hi All

I'm hoping someone can help me with this. I've written the attached script with ltlbearand3 help to read an xml file and search for all the graphics and then copy them from the source directory to a new destination directory. This was working fine until they decided to change the we receive our graphics. The files will always be a numeric name containing 9 numbers, so what is happening is that the file lets call it 123456789 will be copied over to c:\graphics\123456\123456789. Now all the files that start with 123456 will be copied into folder c:\graphics\123456\*. When we get another files let call it 122222341 it will create another sub folder in c:\graphics\ called c:\graphics\1222222\ and put it in there.

How will I be able to search for the files in the source directory (c:\graphics\*\*) and then copy it to the destination directory?

Many thanks in advance

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:

Dim fso, outfile, Graphic, Elem
Dim strFromDir, strToDir, strGraphicList(), i
Set fso = CreateObject("Scripting.FileSystemObject")
Set objEmail = CreateObject("CDO.Message")

' **** Set your Directory Values Here ****
strFromDir = "C:\graphics"
strToDir = "C:\newgraphics"
xmlDir = "c:\testnew\"
i = 0

' **** Looking for the XML file using string RLLO ****
Set xmlDoc = CreateObject("Msxml2.DOMDocument")
Set objFolder = fso.GetFolder(xmlDir)
Set xmlFiles = objFolder.Files
	For Each xmlFiles in objFolder.Files
		If InStr(xmlFiles,"RLLO") then
		xml1Doc = xmlFiles.Name
		end If
next

' **** Loading the XML file ****

xmlDoc.load("C:\testnew\" & xml1Doc)
msgbox xml1Doc ' Message to make sure it the correct xml file. Need to remove 

Set ElemList = xmlDoc.getElementsByTagName("Ad")
' ElemList.Length will show you how many AD nodes you found
 msgbox ElemList.Length ' Message to make sure correct amount of AD's

 ' Loop Through your Node List
For Each Elem in ElemList
	' Check to see if this Node has an Attribute Named Graphic
	If not Elem.getAttribute("Graphic") Then
		' Make sure the Array is the right Size
		Redim Preserve strGraphicList(i)
		
		' If so, assign the attributes value to an Array
		strGraphicList(i) = Elem.getAttribute("Graphic")
		
		' Increment the counter
		i = i + 1
	End If
Next

' Loop Through the Array 
For i = 0 to Ubound(strGraphicList) 
	' Make sure the original File Exists in the Source
	If fso.FileExists(strFromDir & "\" & strGraphicList(i)) Then
		' Found the File - Copy to Destination
		fso.CopyFile strFromDir & "\" & strGraphicList(i), strToDir & "\" 
	End If
Next
	' Message to notify that the files should of copied over
	msgbox "All Files should of copied over" 	
	
' Validate that All Files exit in Destination
For i = 0 to Ubound(strGraphicList)
	' Make sure the original File Exists in the Source
	If NOT fso.FileExists(strToDir & "\" & strGraphicList(i)) Then
		' File NOT Found
		objEmail.From = "[email protected]"
		objEmail.To = "[email protected]"
		objEmail.Subject = "Graphic " & strGraphicList(i) & " was not found"
		objEmail.Textbody = "Graphic ID " & strGraphicList(i) & " was not found" 
		objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
		objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
        "xxx.xxx.xxx.xxx" 
		objEmail.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
		objEmail.Configuration.Fields.Update
		objEmail.Send	
	End If
Next
	'Check to see if you have any missing emails send to you 
	msgbox "Any missing graphic emails?"

'' Deleting the Graphics in the source drive
'For i = 0 to Ubound(strGraphicList) 
'' Make sure the original File Exists in the Source
'	If fso.FileExists(strFromDir & "\" & strGraphicList(i)) Then
'		' Found the File - Delete file from Source
'		fso.DeleteFile strFromDir & "\" & strGraphicList(i)
'	End If
'Next
	' All graphics in the source drive shoud be deleted 	
'	msgbox "Graphics should be deleted from source"

' Email to be sent to let MAN know Recruit is ready 
'objEmail.From = "[email protected]"
'objEmail.To = "[email protected]"
'objEmail.Subject = "Recruit is ready" 
'objEmail.Textbody = " Recruit is ready. Have a great weekend" 
'objEmail.Configuration.Fields.Item _
'    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'objEmail.Configuration.Fields.Item _
'    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
'        "xxx.xxx.xxx.xxx" 
'objEmail.Configuration.Fields.Item _
'    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'objEmail.Configuration.Fields.Update
'objEmail.Send

msgbox "Done"

WScript.Quit()

Answer : VBscript to search subfolders and copy files

If the answer to my above question is Yes, then changing lines 49-52 in your script above to the below, should work.

It simply inserts another folder into the source location which is the first 6 characters of the image name.

Destination folder remains unchanged.. I'm assuming it's still goign to the one folder and not sub folders?

                       
             If fso.FileExists(strFromDir & "\"& Mid(strGraphicList(i),0,6) & "\" & strGraphicList(i)) Then 
                ' Found the File - Copy to Destination 
                fso.CopyFile strFromDir & "\"& Mid(strGraphicList(i),0,6) & "\" & strGraphicList(i), strToDir & "\"  
        End If