Solved

Script to shorten file names and copy to different directory

Posted on 2011-03-01
5
843 Views
Last Modified: 2012-05-11
I have a script that sungenwang was kind enough to help me with but I need one change to it. I need it to perform the copying all of the files in the subdirectories to the new location without creating the directory file structure at the new location.

Set objFSO = CreateObject("Scripting.FileSystemObject")

Call MoveFolder("c:\temp", "c:\temp2")


Sub MoveFolder(strSourceFolder, strTargetFolder)
	Set objCurrentFolder = objFSO.GetFolder(strSourceFolder)

	For Each objFile In objCurrentFolder.Files
		strTargetPath = strTargetFolder & "\" & ChangeFileName(objFSO.GetFileName(objFile))
		'msgbox "file" & vbCrLf & objFile & vbCrLf & strTargetPath

		objFSO.CopyFile objFile, strTargetPath
	Next

	For Each objFolder In objCurrentFolder.subFolders
		strTargetNewFolder = strTargetFolder & Replace(objFolder, objFSO.GetParentFolderName(objFolder), "")
		'msgbox "folder" & vbCrLf & objFolder & vbCrLf & strTargetNewFolder
		
		If Not objFSO.FolderExists(strTargetNewFolder) Then
			objFSO.CreateFolder(strTargetNewFolder)
		End If

		Call MoveFolder(objFolder, strTargetNewFolder)
	Next
End Sub


Function ChangeFileName(strFileName)
	intPos = InStr(strFileName, "_")
	
	If intPos > 0 Then
		ChangeFileName = Left(strFileName, InStr(strFileName, "_")-1) & "." & objFSO.GetExtensionName(strFileName)
	Else
		ChangeFileName = strFileName
	End If
	'msgbox ChangeFileName
End Function

Open in new window

0
Comment
Question by:swhitti
  • 2
  • 2
5 Comments
 
LVL 12

Accepted Solution

by:
prashanthd earned 200 total points
ID: 35010675
Hi,

Please try the below modified code.

Set objFSO = CreateObject("Scripting.FileSystemObject")

Call MoveFolder("c:\temp", "c:\temp2")


Sub MoveFolder(strSourceFolder, strTargetFolder)
	Set objCurrentFolder = objFSO.GetFolder(strSourceFolder)

	For Each objFile In objCurrentFolder.Files
		strTargetPath = strTargetFolder & "\" & ChangeFileName(objFSO.GetFileName(objFile))
		'msgbox "file" & vbCrLf & objFile & vbCrLf & strTargetPath

		objFSO.CopyFile objFile, strTargetPath
	Next

	For Each objFolder In objCurrentFolder.subFolders
		'strTargetNewFolder = strTargetFolder & Replace(objFolder, objFSO.GetParentFolderName(objFolder), "")
		'msgbox "folder" & vbCrLf & objFolder & vbCrLf & strTargetNewFolder
		
		'If Not objFSO.FolderExists(strTargetNewFolder) Then
			'objFSO.CreateFolder(strTargetNewFolder)
		'End If

		Call MoveFolder(objFolder, strTargetFolder)
	Next
End Sub


Function ChangeFileName(strFileName)
	intPos = InStr(strFileName, "_")
	
	If intPos > 0 Then
		ChangeFileName = Left(strFileName, InStr(strFileName, "_")-1) & "." & objFSO.GetExtensionName(strFileName)
	Else
		ChangeFileName = strFileName
	End If
	'msgbox ChangeFileName
End Function

Open in new window

0
 
LVL 45

Expert Comment

by:aikimark
ID: 35011814
How do you intend to deal with duplicate filenames causing overwriting?
0
 

Author Comment

by:swhitti
ID: 35012047
Thanks prashanthd!

@aikimark, thanks for the question. In my case I don't mind duplicate filenames causing overwriting as we want the files to update anytime they change in the original folder.
0
 
LVL 45

Assisted Solution

by:aikimark
aikimark earned 100 total points
ID: 35012457
>>...anytime they change in the original folder
This code doesn't look at the change flag or compare modified date values.  Is this doing what you need?

I usually recommend using a Windows API that will hook a program into the file system to get notices of directory/file changes via callback.

===========
The only thing I can suggest to improve performance of the prashanthd code is to:
1. remove the commented code
2. replace the ChangeFileName() function with the following:

Function ChangeFileName(strFileName)
	intPos = InStr(strFileName, "_")
	
	If intPos > 0 Then
		ChangeFileName = Left(strFileName, intPos -1) & "." & objFSO.GetExtensionName(strFileName)
	Else
		ChangeFileName = strFileName
	End If
End Function

Open in new window

0
 

Author Comment

by:swhitti
ID: 35013298
Thanks aikimark. At this point I think this script is going to do what I need it to. I don't think there will be a lot of changes to the existing files just additional ones. Thanks for the recommendations, I incorporated them into the final script I plan on using.
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

In this article we want to have a look at the directory attributes which are used by Microsoft to store the so called Security Identifiers (SID). These SIDs plays an important role in delegating and granting permissions and in authentication of trus…
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

25 Experts available now in Live!

Get 1:1 Help Now