• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 236
  • Last Modified:

Export email threads and attachment from filesystem into seperate folders

Preface:   we are currently migrating one users (we'll call him Ted) mailbox from his outlook to a document management system.  Reason being is that he stored ALL of his working documents in outlook by emailing working drafts to himself and others.  He did not use a file server.  I know thats wrong in everyway, however its my job to move his documents and emails to our new system so they can be managed.

I have used a 30 day free trial of "outlook attachment sniffer" to export Teds outlook folder structure + emails + attachments to the file system.  I was able to name the emails <subject (without FW or RE)>.msg.  And all the attachments were stripped out and named <subject>---<attachmentname>.<extension>

here is an actual naming structure from the export:

Rev 2 of TOTAL proposal for RGV. -2.msg
Rev 2 of TOTAL proposal for RGV. -3.msg
Rev 2 of TOTAL proposal for RGV..msg
Rev 2 of TOTAL proposal for RGV.---TOTALpricereduction109.doc

These three emails and attachment are all part of an email thread, i.e. the orginal plus RE or FWDs (they are incremented by the number).  What i would like to do is write a script to move all emails and attachments of a single thread into their own folder named after the subject.

What would be the easiest way to accomplish this and does anyone have a script that could be modified to pull this off
0
sknoll84
Asked:
sknoll84
  • 18
  • 17
1 Solution
 
TakedaTCommented:
Are all of these files under one big directory?  And was the double period in the third line between "RGV..msg"a typo?

Rev 2 of TOTAL proposal for RGV. -2.msg
Rev 2 of TOTAL proposal for RGV. -3.msg
Rev 2 of TOTAL proposal for RGV..msg
Rev 2 of TOTAL proposal for RGV.---TOTALpricereduction109.doc
0
 
TakedaTCommented:
Could you show an actual directory listing from a cmd prompt so syntax is exact?  Not the whole thing, just a page or so.  Just need to make sure syntax is right.  For example, I noticed there is a space before the -2 and -3 in the filenames.
0
 
sknoll84Author Commented:
no, the .msg and attachments are within a folder structure, with many branches.  That is not a Typo, the subject for that message ended in a period.
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
sknoll84Author Commented:
04/29/2009  10:59 AM    <DIR>          .
04/29/2009  10:59 AM    <DIR>          ..
01/28/2009  09:37 PM            57,344 Rev 2 of TOTAL proposal for RGV. - 2.msg
01/28/2009  10:33 PM            53,248 Rev 2 of TOTAL proposal for RGV. - 3.msg
01/28/2009  08:52 PM            47,616 Rev 2 of TOTAL proposal for RGV.---TOTALpricereduction109.doc
01/28/2009  08:52 PM           114,688 Rev 2 of TOTAL proposal for RGV..msg
01/29/2009  12:28 PM            78,848 TDG 1-29-09 Red-Line Draft---TOTAL G-5 Price Reduction Letter TDG Red-Line 1-29-09.doc
01/29/2009  12:28 PM           131,072 TDG 1-29-09 Red-Line Draft.msg
01/29/2009  11:03 AM            90,112 TOTAL's Minutes of 1-20-09 Meeting.msg
               7 File(s)        572,928 bytes
               2 Dir(s)  53,878,493,184 bytes free
0
 
sknoll84Author Commented:
So in that example, anything that contained the string (attachment or msg file): Rev 2 of TOTAL proposal for RGV would get placed in a folder called "Rev 2 of TOTAL proposal for RGV"
0
 
TakedaTCommented:
Can you show examples of what the dir looks like for one with more than 10 conversations.  And also one with multiple attachments?

This is a bit complicated trying to make the script know whether the number before the last period is part of the subject or part of the numbering scheme for a conversation.
0
 
sknoll84Author Commented:
04/29/2009  11:00 AM    <DIR>          .
04/29/2009  11:00 AM    <DIR>          ..
03/10/2009  05:10 PM            25,600 3-10-09 Draft of Text---Shell Bussell Text re Shale Shaker Replacement 3-10-09.doc
03/10/2009  05:10 PM            81,920 3-10-09 Draft of Text.msg
03/30/2009  04:12 PM            44,032 3-30-09 Draft of Shale Shaker Letter---Shell Shale Shaker Letter TDG Red-Line 3-30-09.doc
03/30/2009  04:12 PM           126,976 3-30-09 Draft of Shale Shaker Letter.msg
03/13/2009  07:12 AM             4,928 Axiom Estimate---JP Bussel Discussion_axiom and mod cost_RDC.ZIP
03/13/2009  07:12 AM            65,536 Axiom Estimate.msg
03/14/2009  08:16 PM            90,112 Blake's 3-14 Comment.msg
03/18/2009  09:53 PM           102,400 Blake's 3-16 Comments.msg
03/16/2009  10:50 AM            49,152 Draft #2.msg
03/16/2009  09:24 PM            27,648 Draft 3---JP Bussell Shaker change draft 3 MD0309.doc
03/16/2009  09:24 PM            86,016 Draft 3.msg
03/13/2009  01:57 PM            56,760 Email to Shell---29524 Derrick Shaker Spares.pdf
03/13/2009  01:57 PM            43,170 Email to Shell---31121 Brandt Shaker Spares.pdf
03/13/2009  01:57 PM            45,360 Email to Shell---32404 derrick shaker spares.pdf
03/13/2009  01:57 PM            52,363 Email to Shell---Brandt Shakers 058.pdf
03/13/2009  01:57 PM            30,269 Email to Shell---Derrick Shakers 058.pdf
03/13/2009  01:57 PM            94,133 Email to Shell---Rescue Boat PO.pdf
03/13/2009  01:57 PM           454,656 Email to Shell.msg
04/02/2009  04:24 PM            43,520 Final Letter---Shell Shale Shaker Letter TDG Red-Line 4-2-09.doc
04/02/2009  04:24 PM           122,880 Final Letter.msg
03/30/2009  05:39 AM            73,728 Revised letter agreement - 2.msg
03/24/2009  12:52 PM            39,424 Revised letter agreement---Shell Shale Shaker Letter 3-23-09.doc
03/30/2009  05:39 AM             7,645 Revised letter agreement---Shell Shale Shaker Letter 3-23-09.ZIP
03/24/2009  12:52 PM           106,496 Revised letter agreement.msg
03/16/2009  11:13 AM            69,632 Revised Shaker deal.msg
04/22/2009  11:45 AM            73,728 shaker letter.msg
03/10/2009  09:08 AM            73,728 Shaker PO's & Cost Summary - 2.msg
03/10/2009  07:23 AM            21,504 Shaker PO's & Cost Summary---058 AXIOM SHAKR COST ALLOCATION.xls
03/10/2009  07:23 AM            56,760 Shaker PO's & Cost Summary---29524 Derrick Shaker Spares.pdf
03/10/2009  07:23 AM            43,170 Shaker PO's & Cost Summary---31121 Brandt Shaker Spares.pdf
03/10/2009  07:23 AM            45,360 Shaker PO's & Cost Summary---32404 derrick shaker spares.pdf
03/10/2009  07:23 AM            52,363 Shaker PO's & Cost Summary---Brandt Shakers 058.pdf
03/10/2009  07:23 AM            30,269 Shaker PO's & Cost Summary---Derrick Shakers 058.pdf
03/10/2009  07:23 AM           368,640 Shaker PO's & Cost Summary.msg
03/10/2009  07:28 AM            76,159 Shaker Quote---EQ_254 - Rowan 8 x Option.pdf
03/10/2009  07:28 AM             4,072 Shaker Quote---image001.jpg
03/10/2009  07:28 AM           229,376 Shaker Quote.msg
04/16/2009  08:33 AM            69,632 Shale shaker letter.msg
04/22/2009  06:57 AM            65,536 Signed Contract and Shaker letter agreement.msg
03/13/2009  06:47 PM            86,016 TDG 3-13-09 Draft - 2.msg
03/13/2009  11:16 AM            56,760 TDG 3-13-09 Draft---29524 Derrick Shaker Spares.pdf
03/13/2009  11:16 AM            43,170 TDG 3-13-09 Draft---31121 Brandt Shaker Spares.pdf
03/13/2009  11:16 AM            45,360 TDG 3-13-09 Draft---32404 derrick shaker spares.pdf
03/13/2009  11:16 AM            52,363 TDG 3-13-09 Draft---Brandt Shakers 058.pdf
03/13/2009  11:16 AM            30,269 TDG 3-13-09 Draft---Derrick Shakers 058.pdf
03/13/2009  11:16 AM            94,133 TDG 3-13-09 Draft---Rescue Boat PO.pdf
03/13/2009  06:47 PM            30,720 TDG 3-13-09 Draft---Shell Bussell Text re Shale Shakers and Speed Boat 3-13-09.doc
03/13/2009  11:16 AM           446,464 TDG 3-13-09 Draft.msg
03/19/2009  10:47 PM            94,208 TDG 3-19-09 Revisions to Shell Email.msg
              49 File(s)      4,134,116 bytes
               2 Dir(s)  53,879,119,872 bytes free
0
 
sknoll84Author Commented:
ok, I figured out a way to place three dashes after the subject to serve as a delimeter.  i.e.

NMD Regs--- - 2.msg
NMD Regs---.msg
NMD Regs---Facility Reg Section 70.doc
NMD Regs---image001 - 2.gif
NMD Regs---image001.gif
NMD Regs---NMD Crane Standard 854 4 Jul 07.pdf
0
 
TakedaTCommented:
That should help out a lot.  Im working on it, but I may not be able to finish until tomorow as I leave here in 20 minutes.
0
 
TakedaTCommented:
Give this code a try.  I tested it on some dummy files and it seems to work well.  You need to replace the paths in the first 2 lines.  I had it put everthing in a different location all together because of the recursive loop.  I would keep the destination on the same hard drive to make the script finish quickly.  This is also assuming that every file name had --- in it.  If a file is encountered that doesnt have --- in it, the script skips it.
strSourceDir = "D:\test\test\"
strDestDir = "D:\test\test2\"
dim objFSO : set objFSO = CreateObject("Scripting.FileSystemObject")
 
If not objFSO.FolderExists(strSourceDir) then
	MsgBox "Your source dir does not exist. Please verify that "&strSourceDir&" exists and run this script again."
	wscript.quit
Elseif not objFSO.FolderExists(strDestDir) then
	MsgBox "Your destination dir does not exist. Please create "&strDestDir&" and run this script again."
	wscript.quit
End If
 
dim objDir : set objDir = objFSO.GetFolder(strSourceDir)
 
SearchDir objDir
Function SearchDir(strCurrentDir)
	For Each file In strCurrentDir.Files
		If instr(file,"---")>0 then
			strDest = replace(left(file,instr(file,"---")-1),strSourceDir,strDestDir)
			If objFSO.FolderExists(strDest) then
				objFSO.MoveFile file,strDest&"\"&file.name
			Elseif not objFSO.FolderExists(strDest) then
				objFSO.CreateFolder(strDest)
				objFSO.MoveFile file,strDest&"\"&file.name
			End If
		End If
	Next
	For Each folder In strCurrentDir.SubFolders
		If not objFSO.FolderExists(replace(folder,strSourceDir,strDestDir)) then
			objFSO.CreateFolder(replace(folder,strSourceDir,strDestDir))
		End If
		SearchDir folder
	Next
End Function

Open in new window

0
 
sknoll84Author Commented:
im very impressed, worked like a champ.  Couple things i would like to tweek---1.  echo to the screen if a file is skipped. 2.  If a single email exists, just copy it to the destination, no need to create a folder.  
0
 
TakedaTCommented:
Here you go.  As it is, it echos skipped files.  If you would rather it move them, then comment out this line:

wscript.echo file & " was skipped."

by adding a ' in front.  Then uncomment the 2 lines just above it:

'strDest = replace(strCurPath,strSourceDir,strDestDir)
'objFSO.MoveFile file,strDest&"\"&file.name

by deleting the ' in the front.
strSourceDir = "D:\test\test\"
strDestDir = "D:\test\test2\"
dim objFSO : set objFSO = CreateObject("Scripting.FileSystemObject")
 
If not objFSO.FolderExists(strSourceDir) then
	MsgBox "Your source dir does not exist. Please verify that "&strSourceDir&" exists and run this script again."
	wscript.quit
Elseif not objFSO.FolderExists(strDestDir) then
	MsgBox "Your destination dir does not exist. Please create "&strDestDir&" and run this script again."
	wscript.quit
End If
 
dim objDir : set objDir = objFSO.GetFolder(strSourceDir)
 
SearchDir objDir
Function SearchDir(strCurrentDir)
	For Each file In strCurrentDir.Files
		strCurFile = file.name
		strCurPath = replace(file.path,file.name,"")
		'If instr(file,"---")>0 then wscript.echo file.name&vbcrlf&MultiFilesExist(strCurPath,strCurFile)
		If instr(file,"---")>0 and MultiFilesExist(strCurPath,strCurFile)=False then
			strMultiPath = replace(left(file,instr(file,"---")-1),strSourceDir,strDestDir)
			If objFSO.FolderExists(strMultiPath) then		
				objFSO.MoveFile file,strMultiPath&"\"&file.name
			Else
				strDest = replace(strCurPath,strSourceDir,strDestDir)
				objFSO.MoveFile file,strDest&"\"&file.name
			End If
		Elseif instr(file,"---")>0 and MultiFilesExist(strCurPath,strCurFile)=True then	
			strDest = replace(left(file,instr(file,"---")-1),strSourceDir,strDestDir)
			If objFSO.FolderExists(strDest) then
				objFSO.MoveFile file,strDest&"\"&file.name
			Elseif not objFSO.FolderExists(strDest) then
				objFSO.CreateFolder(strDest)
				objFSO.MoveFile file,strDest&"\"&file.name
			End If				
		Else
			'strDest = replace(strCurPath,strSourceDir,strDestDir)
			'objFSO.MoveFile file,strDest&"\"&file.name
			wscript.echo file & " was skipped."
		End If
	Next
	For Each folder In strCurrentDir.SubFolders
		If not objFSO.FolderExists(replace(folder,strSourceDir,strDestDir)) then
			objFSO.CreateFolder(replace(folder,strSourceDir,strDestDir))
		End If
		SearchDir folder
	Next
End Function
Function MultiFilesExist(strCurrentDir,strCurrentFile)
	dim objDir2 : set objDir2 = objFSO.GetFolder(strCurrentDir)
	MultiFilesExist = False
	If instr(strCurrentFile,"---")>0 then
		strSubject2 = left(strCurrentFile,instr(strCurrentFile,"---")-1)
		For Each file2 In objDir2.Files
			If file2.name<>strCurrentFile and instr(file2.name,strSubject2)>0 then
				MultiFilesExist = True					
			End If
		Next
	End If
	set objDir2 = nothing	
End Function

Open in new window

0
 
sknoll84Author Commented:
ok, ive ran both versions of that script against a bigger dataset and am receiving a "path not found" error after a few iterations.  After 85 files and 45 folders, it throws that error.
0
 
TakedaTCommented:
Can I have more info.  Line numbers, directory listing where it failed...its hard to write a script with limited info on the data its working with.
0
 
sknoll84Author Commented:
sorry, i thought i had uploaded the screenshot.....

Line 35 |  Char: 5 |  Error:  Path not found |  Code:  800A004c |  Source:  Microsoft VBScript runtime error.
0
 
sknoll84Author Commented:
found the problem.  Subject contained three periods----windows folders can't contain periods.  Example:  One Final Thought on WT...---.msg
0
 
TakedaTCommented:
Try this.  It could be done more efficiently, but I just dont have the time right now.  It should replace the . in the folder with spaces.  Let me know if there are other illegal chars...
strSourceDir = "D:\test\test\"
strDestDir = "D:\test\test2\"
dim objFSO : set objFSO = CreateObject("Scripting.FileSystemObject")
 
If not objFSO.FolderExists(strSourceDir) then
	MsgBox "Your source dir does not exist. Please verify that "&strSourceDir&" exists and run this script again."
	wscript.quit
Elseif not objFSO.FolderExists(strDestDir) then
	MsgBox "Your destination dir does not exist. Please create "&strDestDir&" and run this script again."
	wscript.quit
End If
 
dim objDir : set objDir = objFSO.GetFolder(strSourceDir)
 
SearchDir objDir
Function SearchDir(strCurrentDir)
	For Each file In strCurrentDir.Files
		strCurFile = file.name
		strCurPath = replace(file.path,file.name,"")
		'If instr(file,"---")>0 then wscript.echo file.name&vbcrlf&MultiFilesExist(strCurPath,strCurFile)
		If instr(file,"---")>0 and MultiFilesExist(strCurPath,strCurFile)=False then
			strMultiPath = replace(replace(left(file,instr(file,"---")-1),strSourceDir,strDestDir),"."," ")
			If objFSO.FolderExists(strMultiPath) then		
				objFSO.MoveFile file,strMultiPath&"\"&file.name
			Else
				strDest = replace(strCurPath,strSourceDir,strDestDir)
				objFSO.MoveFile file,strDest&"\"&file.name
			End If
		Elseif instr(file,"---")>0 and MultiFilesExist(strCurPath,strCurFile)=True then	
			strDest = replace(replace(left(file,instr(file,"---")-1),strSourceDir,strDestDir),"."," ")
			If objFSO.FolderExists(strDest) then
				objFSO.MoveFile file,strDest&"\"&file.name
			Elseif not objFSO.FolderExists(strDest) then
				objFSO.CreateFolder(strDest)
				objFSO.MoveFile file,strDest&"\"&file.name
			End If				
		Else
			'strDest = replace(strCurPath,strSourceDir,strDestDir)
			'objFSO.MoveFile file,strDest&"\"&file.name
			wscript.echo file & " was skipped."
		End If
	Next
	For Each folder In strCurrentDir.SubFolders
		If not objFSO.FolderExists(replace(folder,strSourceDir,strDestDir)) then
			objFSO.CreateFolder(replace(folder,strSourceDir,strDestDir))
		End If
		SearchDir folder
	Next
End Function
Function MultiFilesExist(strCurrentDir,strCurrentFile)
	dim objDir2 : set objDir2 = objFSO.GetFolder(strCurrentDir)
	MultiFilesExist = False
	If instr(strCurrentFile,"---")>0 then
		strSubject2 = left(strCurrentFile,instr(strCurrentFile,"---")-1)
		For Each file2 In objDir2.Files
			If file2.name<>strCurrentFile and instr(file2.name,strSubject2)>0 then
				MultiFilesExist = True					
			End If
		Next
	End If
	set objDir2 = nothing	
End Function

Open in new window

0
 
sknoll84Author Commented:
I'm trying to get this script to work with a very large dataset now and i believe I am running into file system contraints in regards to illegal characters and or folder name length--im not really sure how to debug as i can't pinpoint which file it is erroring out on.....keep getting the "path not found", line 26, char 5 after it runs and successfully copies over a good amount of files/folders.  
0
 
TakedaTCommented:
Try it now.  I added a function to remove any characters that I have found to be illegal from the path.
strSourceDir = "D:\test\test\"
strDestDir = "D:\test\test2\"
dim objFSO : set objFSO = CreateObject("Scripting.FileSystemObject")
 
If not objFSO.FolderExists(strSourceDir) then
	MsgBox "Your source dir does not exist. Please verify that "&strSourceDir&" exists and run this script again."
	wscript.quit
Elseif not objFSO.FolderExists(strDestDir) then
	MsgBox "Your destination dir does not exist. Please create "&strDestDir&" and run this script again."
	wscript.quit
End If
 
dim objDir : set objDir = objFSO.GetFolder(strSourceDir)
 
SearchDir objDir
Function SearchDir(strCurrentDir)
	For Each file In strCurrentDir.Files
		strCurFile = file.name
		strCurPath = replace(file.path,file.name,"")
		'If instr(file,"---")>0 then wscript.echo file.name&vbcrlf&MultiFilesExist(strCurPath,strCurFile)
		If instr(file,"---")>0 and MultiFilesExist(strCurPath,strCurFile)=False then
			strMultiPath = RemoveIllegal(replace(left(file,instr(file,"---")-1),strSourceDir,strDestDir))
			If objFSO.FolderExists(strMultiPath) then		
				objFSO.MoveFile file,strMultiPath&"\"&file.name
			Else
				strDest = replace(strCurPath,strSourceDir,strDestDir)
				objFSO.MoveFile file,strDest&"\"&file.name
			End If
		Elseif instr(file,"---")>0 and MultiFilesExist(strCurPath,strCurFile)=True then	
			strDest = RemoveIllegal(replace(left(file,instr(file,"---")-1),strSourceDir,strDestDir))
			If objFSO.FolderExists(strDest) then
				objFSO.MoveFile file,strDest&"\"&file.name
			Elseif not objFSO.FolderExists(strDest) then
				objFSO.CreateFolder(strDest)
				objFSO.MoveFile file,strDest&"\"&file.name
			End If				
		Else
			'strDest = replace(strCurPath,strSourceDir,strDestDir)
			'objFSO.MoveFile file,strDest&"\"&file.name
			wscript.echo file & " was skipped."
		End If
	Next
	For Each folder In strCurrentDir.SubFolders
		If not objFSO.FolderExists(replace(folder,strSourceDir,strDestDir)) then
			objFSO.CreateFolder(replace(folder,strSourceDir,strDestDir))
		End If
		SearchDir folder
	Next
End Function
Function RemoveIllegal(strString)
	strString = replace(strString,".","")
	strString = replace(strString,"\","")
	strString = replace(strString,"/","")
	strString = replace(strString,":","")
	strString = replace(strString,"*","")
	strString = replace(strString,"?","")
	strString = replace(strString,chr(34),"")
	strString = replace(strString,"<","")
	strString = replace(strString,">","")
	strString = replace(strString,"|","")
	RemoveIllegal = strString
End Function
Function MultiFilesExist(strCurrentDir,strCurrentFile)
	dim objDir2 : set objDir2 = objFSO.GetFolder(strCurrentDir)
	MultiFilesExist = False
	If instr(strCurrentFile,"---")>0 then
		strSubject2 = left(strCurrentFile,instr(strCurrentFile,"---")-1)
		For Each file2 In objDir2.Files
			If file2.name<>strCurrentFile and instr(file2.name,strSubject2)>0 then
				MultiFilesExist = True					
			End If
		Next
	End If
	set objDir2 = nothing	
End Function

Open in new window

0
 
TakedaTCommented:
If this still stops with errors, then it may be a case of a path thats too long or something else.  You can always put a "on error resume next" at the beginning so that the script will keep going even if an error occurs.  Then you can see what files are left to see why you were getting errors.
0
 
sknoll84Author Commented:
now i am getting folders created that contain the full local destination path+Folder+subfolder in the folder where the script is executed.  Basically the subfolders are not getting created in the destination directory.
fullpath.jpg
0
 
TakedaTCommented:
And you are sure this was not happening before?  Its hard to remember as its been almost a week since I posted last...
0
 
sknoll84Author Commented:
hasnt happened until i ran the last code
0
 
sknoll84Author Commented:
ok, i just ran your code from post 24271702, and added the "on error resume next" at the very top of the script.  It doesnt throw an error, however, it appears to hang.
0
 
TakedaTCommented:
OK...I think I found where I messed up.  I was removing the slashes in the path because of where I did the replacing.  Try this.
strSourceDir = "D:\test\test\"
strDestDir = "D:\test\test2\"
dim objFSO : set objFSO = CreateObject("Scripting.FileSystemObject")
 
If not objFSO.FolderExists(strSourceDir) then
	MsgBox "Your source dir does not exist. Please verify that "&strSourceDir&" exists and run this script again."
	wscript.quit
Elseif not objFSO.FolderExists(strDestDir) then
	MsgBox "Your destination dir does not exist. Please create "&strDestDir&" and run this script again."
	wscript.quit
End If
 
dim objDir : set objDir = objFSO.GetFolder(strSourceDir)
 
SearchDir objDir
Function SearchDir(strCurrentDir)
	For Each file In strCurrentDir.Files
		strCurFile = file.name
		strCurPath = replace(file.path,file.name,"")
		'If instr(file,"---")>0 then wscript.echo file.name&vbcrlf&MultiFilesExist(strCurPath,strCurFile)
		If instr(file,"---")>0 and MultiFilesExist(strCurPath,strCurFile)=False then
			strMultiPath = RemoveIllegal(replace(left(file,instr(file,"---")-1),strSourceDir,strDestDir))
			If objFSO.FolderExists(strMultiPath) then		
				objFSO.MoveFile file,strMultiPath&"\"&file.name
			Else
				strDest = replace(strCurPath,strSourceDir,strDestDir)
				objFSO.MoveFile file,strDest&"\"&file.name
			End If
		Elseif instr(file,"---")>0 and MultiFilesExist(strCurPath,strCurFile)=True then	
			strDest = RemoveIllegal(replace(left(file,instr(file,"---")-1),strSourceDir,strDestDir))
			If objFSO.FolderExists(strDest) then
				objFSO.MoveFile file,strDest&"\"&file.name
			Elseif not objFSO.FolderExists(strDest) then
				objFSO.CreateFolder(strDest)
				objFSO.MoveFile file,strDest&"\"&file.name
			End If				
		Else
			'strDest = replace(strCurPath,strSourceDir,strDestDir)
			'objFSO.MoveFile file,strDest&"\"&file.name
			wscript.echo file & " was skipped."
		End If
	Next
	For Each folder In strCurrentDir.SubFolders
		If not objFSO.FolderExists(replace(folder,strSourceDir,strDestDir)) then
			objFSO.CreateFolder(replace(folder,strSourceDir,strDestDir))
		End If
		SearchDir folder
	Next
End Function
Function RemoveIllegal(strString)
	strFull = strString
	strOrig = mid(strString,instrrev(strString,"\")+1)
	strString = strOrig
	strString = replace(strString,".","")
	strString = replace(strString,"\","")
	strString = replace(strString,"/","")
	strString = replace(strString,":","")
	strString = replace(strString,"*","")
	strString = replace(strString,"?","")
	strString = replace(strString,chr(34),"")
	strString = replace(strString,"<","")
	strString = replace(strString,">","")
	strString = replace(strString,"|","")
	RemoveIllegal = replace(strFull,strOrig,strString)
End Function
Function MultiFilesExist(strCurrentDir,strCurrentFile)
	dim objDir2 : set objDir2 = objFSO.GetFolder(strCurrentDir)
	MultiFilesExist = False
	If instr(strCurrentFile,"---")>0 then
		strSubject2 = left(strCurrentFile,instr(strCurrentFile,"---")-1)
		For Each file2 In objDir2.Files
			If file2.name<>strCurrentFile and instr(file2.name,strSubject2)>0 then
				MultiFilesExist = True					
			End If
		Next
	End If
	set objDir2 = nothing	
End Function

Open in new window

0
 
sknoll84Author Commented:
error out again, no path found.  the source directory is missing files that is not in the destination.  As you can see, the "Authorization Procedure" folder had emails removed from it, however they did not appear in the destination folder.   The "first amendment" folder is the first folder to contain data in the source"  dir listing below....





Draft Amendment to Consortium Agreement---first amendment k draft v8 final draft clean 11mar09.doc
3-20-09 Draft--- - 2.msg
3-20-09 Draft---.msg
3-20-09 Draft---Blackstone 1st Amendment
final version clean 20mar09.doc
Draft---Blackstone 1st Amendment
final version marked 20mar09.doc
3-20-09 Draft---Blackstone_1st_Amendment_
FINAL_version_marked_20mar09.doc
3-20-09 POA Draft--- - 2.msg
3-20-09 POA Draft---.msg
3-20-09 POA Draft---Blackston poder cuent
as bancarias 20mar09.doc
3-20-09 POA Draft---Blackston poder cuent
as bancarias B 20mar09.doc
3-9-09 Draft of Consortium Agreement---.msg
 3-9-09 Draft of Consortium Agreement---first amendment k draft 9mar09.doc
3-9-09 Draft of Consortium Agreement---amcedrill POA keller marked 9mar09.doc
3-9-09 Draft of Consortium Agreement---Sec Cert re Mark Keller for Mexico.pdf
Additional provision for Blackstone contract---.msg
Additional provision for Blackstone contract---Blackstone 1st Amendment final version clean B 17mar09.doc
Additional provision for Blackstone contract---Blackstone 1st Amendment final version marked B 17mar09.doc
Amendment Agreement---.msg
Amendment Agreement---Blackstone 1st Amendment final version clean B 17mar09.doc
Amendment Agreement---Blackstone 1st Amendment final version marked B 17mar09.doc
Blackstone's Agency Agreement---.msg
Blackstone's Agency Agreement---Agency Agreement - GIS Rev 1.doc
Blackstone's Agency Agreement---DOCUMENTOS LEGALES Lic 018 amce BLACKSTONE.pdf
Blackstone; V3 of the draft amendment to the consortium agreemen---.msg
Blackstone; V3 of the draft amendment to the consortium agreemen---first amendment k draft v3 9mar09.doc
Blackstone; V3 of the draft amendment to the consortium agreemen---first amendment k draft v3 clean 9mar09.doc
Blackstone; V4 of the draft amendment to the consortium agreemen---.msg
Blackstone; V4 of the draft amendment to the consortium agreemen---first amendment k draft v4 TDG Red-Line 10mar09.doc
Draft #8---.msg
Draft #8---first amendment k draft v8 final draft clean 11mar09.doc
Draft #8---first amendment k draft v8 joint Red-Line 11mar09.doc
Fully Signed First Amendment---.msg
Fully Signed First Amendment---2009033114
4110757.pdf
3-9-09 Draft---.msg
MT Comments to 3-9-09 Draft---first amendment k draft 9mar09.doc
amce BLACKSTONE BID---.msg
amce BLACKSTONE BID---Agency Agreement -
GIS Rev 1.doc
amce BLACKSTONE BID---DOCUMENTOS LEGALES
Lic 018 amce BLACKSTONE.pdf
TDG 3-13-09 Red-Line Draft--- - 2.msg
TDG 3-13-09 Red-Line Draft---.msg
TDG 3-13-09 Red-Line Draft---Blackstone 1st Amendment draft clean 16mar09.doc
TDG 3-13-09 Red-Line Draft---Blackstone 1st Amendment draft marked 16mar09.doc
3-13-09 Red-Line Draft---Blackstone 1st Amendment TDG Red-Line 3-13-09.doc
TDG 3-13-09 Red-Line Draft---Code of Business Conduct and Ethics.pdf
3-13-09 Red-Line Draft---Exhibits.doc



error.jpg
0
 
TakedaTCommented:
In the picture, the authorization procedure folder is at the same directory level as the AngolaG-7 dir.  You say its missing, but it may just be further down the list.  Is it dying on the AngolaG-7 dir and not even making it do the next root dir?

Anyhow, I cant do anything now as I am not at my office.  If you need to get this resolved, then it will have to wait for tomorrow.  Its hard to troubleshoot when you dont reply for hours or even days.  I lose track of where I am...
0
 
TakedaTCommented:
If you are really interested in getting this to work, it would make it much quicker and easier for me to test if I had the files to test with.  If you dont mind me seeing file names, you can use the robocopy.exe utility from the resource kit with the /create switch to copy the dir structure with 0 byte files.  You can zip or rar those empty files with the directory structure and send it to my email address that I will give you if you choose to go this route.
0
 
sknoll84Author Commented:
what is your email.
0
 
TakedaTCommented:
I posted it in my profile.  I will remove it tomorrow or as soon as I know you have it.
0
 
sknoll84Author Commented:
got it.  I will be emailing you in the next couple of hours
0
 
TakedaTCommented:
I found the problem.  The total length of the path + filename is too long.  Check the attached pic.  Both the path + filename combined = over 256 characters for this file.

D:\test\test2\BlackstoneConsortium Agreement 2009\Consortium Agreement\First Amendment\Blackstone V3 of the draft amendment to the consortium agreemen\Blackstone; V3 of the draft amendment to the consortium agreemen---first amendment k draft v3 clean 9mar09.doc
untitled.JPG
0
 
sknoll84Author Commented:
anyway to truncate the foldername to squeeze the length down to under 256.  I would imagine that these long names are on offs.
0
 
TakedaTCommented:
OK...I had it truncate the long files.  I changed the .vbs into a .hta so you have options to watch progress or continue on errors.  When you try it, only check the "show progress" option and it should work.  It worked on all of the data you provided.
<head>
<title>Folder Organizer</title>
<HTA:APPLICATION 
     APPLICATIONNAME="Folder Organizer"
     SCROLL="yes"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="maximize"
>
<style type="text/css">
 
html {
font-family:arial;
font-size:smaller;
 
}
 
table {
border-collapse:collapse;
border:solid 1px black;
font-family:arial;
font-size:0.8em;
}
 
tr, td, th {
border-collapse:collapse;
border-style:solid;
}
 
td { border-width: 1px; }
 
 
</style>
 
 
</head>
<script language="vbscript">
Sub RunMain
	
	strSourceDir = sourcedir.value
	strDestDir = destdir.value
	dim objFSO : set objFSO = CreateObject("Scripting.FileSystemObject")
 
	If not objFSO.FolderExists(strSourceDir) then
		StatusLine.InnerHTML = StatusLine.InnerHTML & "Your source dir does not exist. Please verify that "&_
			strSourceDir&" exists and run this script again."
	Elseif not objFSO.FolderExists(strDestDir) then
		StatusLine.InnerHTML = StatusLine.InnerHTML & "Your destination dir does not exist. Please create "&_
			strDestDir&" and run this script again."
	Else
		SourceDir.Disabled = True
		DestDir.Disabled = True
		RunButton.Disabled = True
		ErrorPassing.Disabled = True
		ScreenOutput.Disabled = True
		StatusLine.InnerHTML = "Started "&Now&"<br>"
		dim objDir : set objDir = objFSO.GetFolder(strSourceDir)
		SearchDir objDir,strSourceDir,strDestDir
		StatusLine.InnerHTML =  "Done "&Now&"<br>"&StatusLine.InnerHTML 
		SourceDir.Disabled = False
		DestDir.Disabled = False
		RunButton.Disabled = False
		ErrorPassing.Disabled = False
		ScreenOutput.Disabled = False
	End If
	
End Sub
Function SearchDir(strCurrentDir,strSourceDir,strDestDir)
	dim objFSO : set objFSO = CreateObject("Scripting.FileSystemObject")
	If ErrorPassing.Checked then On error resume next
	For Each file In strCurrentDir.Files
		If ScreenOutput.Checked = True then Sleep 1
		If InStr(file.name,"---")<>0 then
			strCurFile = file.name
			strCurPath = replace(file.path,file.name,"")
			strCurSubject = RemoveIllegal(left(file.name,instrrev(file.name,"---")-1))
			strCurDest = replace(strCurPath,strSourceDir,strDestDir)
			strCurDestSubj = replace(strCurPath,strSourceDir,strDestDir)&strCurSubject
			
			If MultiFilesExist(strCurPath,strCurFile)=False then
				If objFSO.FolderExists(strCurDestSubj) then		
					If ScreenOutput.Checked = True then
						StatusLine.InnerHTML = " MOVING FILE==========> "&_
						strCurDestSubj&"<br>"&"&nbsp==="&file.name&_
						"<br>--------------------------------------------------------<br>"&_
						StatusLine.InnerHTML
					End If
					objFSO.MoveFile file,FileCheck(strCurDestSubj&"\"&file.name)
 
				Else
					If ScreenOutput.Checked = True then
						StatusLine.InnerHTML = " MOVING FILE==========> "&_
						strCurDest&"<br>"&"&nbsp==="&file.name&_
						"<br>--------------------------------------------------------<br>"&_
						StatusLine.InnerHTML
					End If
					objFSO.MoveFile file,FileCheck(strCurDest&"\"&file.name)
				End If
			Else
				If objFSO.FolderExists(strCurDestSubj) then
					If ScreenOutput.Checked = True then
						StatusLine.InnerHTML = " MOVING FILE==========> "&_
						strCurDestSubj&"<br>"&"&nbsp==="&file.name&_
						"<br>--------------------------------------------------------<br>"&_
						StatusLine.InnerHTML
					End If
					objFSO.MoveFile file,FileCheck(strCurDestSubj&"\"&file.name)
				Elseif not objFSO.FolderExists(strCurDestSubj) then
					If ScreenOutput.Checked = True then
						StatusLine.InnerHTML = " CREATING SUBJECT FOLDER ==========>"&strCurDestSubj&_
						"<br>--------------------------------------------------------<br>"&_
						StatusLine.InnerHTML
					End If
					objFSO.CreateFolder(strCurDestSubj)
					If ScreenOutput.Checked = True then
						StatusLine.InnerHTML = " MOVING FILE==========> "&_
						strCurDestSubj&"<br>"&"&nbsp==="&file.name&_
						"<br>--------------------------------------------------------<br>"&_
						StatusLine.InnerHTML
					End If
					objFSO.MoveFile file,FileCheck(strCurDestSubj&"\"&file.name)
				End If	
			End If
		Else
			If ScreenOutput.Checked = True then
				StatusLine.InnerHTML = " MOVING FILE==========> "&_
				replace(replace(file.path,file.name,""),strSourceDir,strDestDir)&_
				"<br>"&"&nbsp==="&file.name&_
				"<br>--------------------------------------------------------<br>"&_
				StatusLine.InnerHTML
			End If
			objFSO.MoveFile file,FileCheck(Replace(strCurrentDir,strSourceDir,strDestDir)&"\"&file.name)
		End If
	Next
	For Each folder In strCurrentDir.SubFolders
		If not objFSO.FolderExists(replace(folder,strSourceDir,strDestDir)) then
			If ScreenOutput.Checked = True then
				StatusLine.InnerHTML = " CREATING DESTINATION FOLDER ----------"&_
				replace(folder,strSourceDir,strDestDir)&_
				"<br>--------------------------------------------------------<br>"&_
				StatusLine.InnerHTML
			End If
			objFSO.CreateFolder(FileCheck(replace(folder,strSourceDir,strDestDir)))
		End If
		
		SearchDir folder,strSourceDir,strDestDir
	Next
End Function
Function FileCheck(dest)
	If len(dest)<256 then
		FileCheck = dest
	Else
		FileCheck = left(dest,251)&mid(dest,instrrev(dest,"."))
	End If
End Function
Function RemoveIllegal(strString)
	strFull = strString
	strOrig = mid(strString,instrrev(strString,"\")+1)
	strString = strOrig
	strString = replace(strString,".","")
	strString = replace(strString,"\","")
	strString = replace(strString,"/","")
	strString = replace(strString,":","")
	strString = replace(strString,";","")
	strString = replace(strString,"*","")
	strString = replace(strString,"?","")
	strString = replace(strString,chr(34),"")
	strString = replace(strString,"<","")
	strString = replace(strString,">","")
	strString = replace(strString,"|","")
	RemoveIllegal = replace(strFull,strOrig,strString)
End Function
Function MultiFilesExist(strCurrentDir,strCurrentFile)
	dim objFSO : set objFSO = CreateObject("Scripting.FileSystemObject")
	dim objDir2 : set objDir2 = objFSO.GetFolder(strCurrentDir)
	MultiFilesExist = False
	If instr(strCurrentFile,"---")>0 then
		strSubject = left(strCurrentFile,instr(strCurrentFile,"---")-1)
		For Each file2 In objDir2.Files
			If file2.name<>strCurrentFile and instr(file2.name,strSubject)>0 then
				MultiFilesExist = True					
			End If
		Next
	End If
	set objDir2 = nothing	
End Function 
Sub Sleep(MSecs) 
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	If objFSO.FileExists("sleeper.vbs")=False Then
		Set objOutputFile = objFSO.CreateTextFile("sleeper.vbs", True)
		objOutputFile.Write "wscript.sleep WScript.Arguments(0)"
		objOutputFile.Close
	End If
	CreateObject("WScript.Shell").Run "sleeper.vbs " & MSecs,1 , True
	If objFSO.FileExists("sleeper.vbs") = True Then	objFSO.DeleteFile("sleeper.vbs")
End Sub
Function TruncateName
 
End Function
</script>
 
<body>
<input type="button" value="Run Script" name="RunButton" onClick="RunMain">
<input type="checkbox" name="ErrorPassing">Error Passing?
<input type="checkbox" name="ScreenOutput">Show progress?<BR><BR>
<table border=0>
<td style='background:c0c0c0'>Source<td><input type="text" value="D:\test\test" name="sourcedir"><tr>
<td style='background:c0c0c0'>Dest  <td><input type="text" value="D:\test\test2" name="destdir"><tr>
</table><br>
<span id="StatusLine">Status</span>
</body>
</html>

Open in new window

0
 
sknoll84Author Commented:
your the man.  500 points!
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 18
  • 17
Tackle projects and never again get stuck behind a technical roadblock.
Join Now