VBA Macro - Loop through folder and move files to other folders

[hurlbut777]

I have 5 folders (ABC_Blue, ABC_Green, ABC_Red, ABC_Yellow, Results). The
folder named Results contains three files (Blue.xls, Green.xls, Red.xls).

I need to create a macro to loop through the results folder, and copy excel
files into the other 4 folders based on whether or not any part of the folder
name contains the name of the exel files. As an example, since ABC_Blue
folder contains Blue within its name, the Blue.xls file should be copied to
this location.

I would be one happy camper if the above could be accomplished, but I
wouldn't know what to do with myself if in addition some functionality could
be added to show any files within the results folder that were not copied
somewhere else. As an example, if there was an excel file name Purple.xls
within the Results folder, it wouldn't be copied to another folder because
there isn't one containing Purple within its name.

I know enough VBA to be dangerous, so if someone can help me get started I'm
sure I can muddle through the rest eventually.

 

[Bernie Deitrick]

You need to specify how 'granular' you want to be: does the B in Blue count when their is a B in
ABC? Probably not....

So, perhaps use two lists of words to look for:

Sub TryNow()
Dim myWords As Variant
Dim myS As Variant
Dim mySearch As String

myWords = Array("Blue", "Green", "Red", "Yellow", "ABC", "DEF", "GHI")

mySearch = "Blue days, ABC nights"
For Each myS In myWords
If InStr(1, mySearch, myS) > 0 Then
MsgBox """" & mySearch & """ has """ & myS & """ somewhere in it"
'Do something else, like copy the file
End If
Next myS

End Sub



HTH,
Bernie
MS Excel MVP

 

[Ronald R. Dodge, Jr.]

You can use something like the following code:

Public Sub pcdSaveFile()
Dim l_objFileSystemObject as Scripting.FileSystemObject,
l_objSourceFolder As Scripting.Folder
Dim l_objFiles as Scripting.Files, l_objCurrentFile as Scripting.File
Set l_objFileSystemObject = New Scripting.FileSystemObject
Set l_objSourceFolder =
l_objFileSystemObject.GetFolder("O:\ExcelFiles\ResultsFolder")
Set l_objFiles = l_objSourceFolder.Files
For Each l_objCurrentFile in l_objFiles
If VBA.InStr(1, l_objCurrentFile.Name, "Red",vbTextCompare) > 0 Then
l_objCurrentFile.Copy "O:\ExcelFiles\RedFolder\" &
l_objCurrentFile.Name, True
End If
Next
Set l_objFiles = Nothing
Set l_objSourceFolder = Nothing
Set l_objFileSystemObject = Nothing
end Sub

--
Thanks,

Ronald R. Dodge, Jr.
Production Statistician
Master MOUS 2000

 

[hurlbut777]

Bernie,

First of all, I appreciate your help. You are correct that I will need to
be more specific and I think your code will work. However, my issue is going
to be that I just used the small number of files and folders as an example.
Within the results folder I will actually have somewhere in the neighborhood
of 200 files, and somewhere in the neighborhood of the same amount of
folders. So typing out the data to be included in myWords and mySearch will
be cumbersome to setup, and if any files or folders are added down the road I
will have to manually adjust that data list. This will be a process I have
to perform on a monthly basis so I would like to remove as much manual vba
adjustments on a on-going basis as possible.

Would there be a way to loop through the results folder to get the file
names and create an array of that information? And say all the other folders
are in a folder named "Everything", would there be a way to loop through all
subfolders within the "Everything" folder and make that an array as well?
That info would become myWords and mySearch if you will.

 

[hurlbut777]

Ronald,

Thank you for your response. If I am reading your code correctly it should
automate the excel file piece I need but I would have to build hundreds of If
statements specificly listing out each folder...if possible I would like to
avoid that but it is beginnning to look like I may just have to bite the
bullet.

 

[ryguy7272]

Maybe:
http://www.rondebruin.nl/copy4.htm

Maybe:
http://www.rondebruin.nl/folder.htm

Hope that helps.
Ryan-----

 

[Incidental]

Hi Hurlbut

The code below may help you out. It works (for me) when using a test
set up that includes. A folder called "Test" and inside that folder
are the folders "ABC_Red", "ABC_Blue","ABC_Green","ABC_Yellow" &
"Results". Inside the "Results" folder i put "Red.xls", "Blue.xls",
"Green.xls", "Yellow.xls" & "Purple.xls". When you run the sub you it
should copy the file "Red.xls" to the folder "ABC_Red" etc and will
not copy the file "Purple.xls" as there is no folder for it to go
into.

Option Explicit

Dim fso As Object
Dim mainDIR, compDIR As Object
Dim subDIRcol, fileCol As Object
Dim DIRObj, fileObj As Object
Dim Str1, Str2 As String
Dim Res As Integer

Sub GetSubDirs()

Set fso = CreateObject("Scripting.FileSystemObject")
Set mainDIR = fso.getfolder("C:\Test")
Set compDIR = fso.getfolder("C:\Test\Results")
Set subDIRcol = mainDIR.SubFolders
Set fileCol = compDIR.Files

For Each fileObj In fileCol

Str1 = Left(fileObj.Name, Len(fileObj.Name) - 4)

For Each DIRObj In subDIRcol

Str2 = Right(DIRObj.Name, Len(DIRObj.Name) - 4)

Res = StrComp(Str1, Str2)

If Res = 0 Then

fso.Copyfile fileObj, DIRObj & "\" & fileObj.Name
Exit For

End If

Next

Next

Set fso = Nothing
Set mainDIR = Nothing
Set compDIR = Nothing
Set subDIRcol = Nothing
Set fileCol = Nothing
Set fileObj = Nothing
Set DIRObj = Nothing

End Sub

I hope this helps you out a bit

Steve

 

[Ronald R. Dodge, Jr.]

As for your array list that you need, one such option is to use a particular
column of an Excel worksheet to list the various characters/words/phrases
you are wanting to have VBA to compare against. You then use another column
to list the path where the file will be copied/moved to. By doing this, you
can then have VBA loop through the list and by the same token, don't have to
hard code it every time, should you want to modify the list and also have
the workbook as a shared workbook. Once the code finds a match, then the
code would pull the destination based on the same row the match took place
and the destination column. If you want to make it a bit more dynamic
rather than having a static range reference within VBA, you can also name
the 2 ranges, and then setup range objects based on those 2 range names.

--
Thanks,

Ronald R. Dodge, Jr.
Production Statistician
Master MOUS 2000

 

[hurlbut777]

Ronald,

What you recommend is pretty much what I had decided to do. I am
encountering one minor issue that I still need help with. The issue is I may
be grabbing a file and trying to save it at a location that doesn't exist...I
need to create some if statement that says if that happens then just move on
down the list of files. The line in code that is causing this issue is:

Workbooks(sCurrFName.SaveAs(Z.Value & sFileStamp & sCurrFName)

If this line of code causing an error, i.e. the path doesn't exist, then I
just want to close the open file, then have a message box pop and say "path
doesn't exist" and then goto NoFolder.

Here is the full code - please be gentle:

Sub FXFE_Controllable()

Dim sCurrFName As String
Dim sFileStamp As String
Dim Y As Range
Set Y = Range("b8")
Dim Z As Range
Set Z = Range("b12")
Dim sDest As String
Dim J As Range
Set J = Range("b13")



With Application
.ScreenUpdating = False
.DisplayAlerts = False
sCurrFName = Dir(Y.Value & "*.xls")
sFileStamp = Range("b5")

Do While sCurrFName <> ""
Worksheets("Home").Range("b14") = sCurrFName

sDest = J.Value
If J.Value = 0 Then
MsgBox "No folder exists for " & sCurrFName, vbInformation
GoTo NoFolder
Else: GoTo NormalProcess
End If

NormalProcess:
Workbooks.Open (Y.Value & sCurrFName)
Workbooks(sCurrFName).SaveAs (Z.Value & sFileStamp & sCurrFName)
Workbooks(sFileStamp & sCurrFName).Close

NoFolder:
sCurrFName = Dir

Loop

.ScreenUpdating = True
.DisplayAlerts = True
End With

Range("b14").Clear

End Sub

 

[Ronald R. Dodge, Jr.]

The line of code you put in, I noticed you left out the closing paranthesis
after the string variable containing the file name, so that is your first
issue.

To see if a particular folder exists, and using the set of code that I had
presented earlier, you can use the following line of code:

If l_objFileSystemObject.FolderExists(<The full path to the folder including
the folder name>) Then
Workbooks(sCurrFName).SaveAs(Z.Value & sFileStamp & sCurrFName)
Else
<Perform tasks relating to the location not existing rather it be
creating the folders programatically or creating an error log>
End If

To create the folders, you may want to use the InStr to locate the
backslashes (\), and then work your way backwards (Back to the root) to
check the existence of such folders and then create them going forward again
(back to the final sub folder), if you want this to be automatically done.
Once the folders are created, you can then perform the SaveAs method on the
workbook object. However, if there is already a file in that location with
that same file name, regardless if you have the DisplayAlert set to "True"
or "False", that save as message box will always appear. If you don't want
that to happen, but rather just right over it, then use the SaveCopyAs
method in place of the SaveAs method. The two main difference between these
two methods, the first one is what I just said, and the second is Excel
treats the file as saving to a backup location without changing things in
other open files linked to the file being saved when using the SaveCopyAs
method like it does with the SaveAs Method.

If you still prefer to use the SaveAs method but don't want the message box
to appear, you then may want to use the FileExists on the particular folder
where the file will be saved to, and if it does exist and you want to
replace it, then use the filesystemobject to delete the file first, then use
the SaveAs method on the workbook object.

--
Thanks,

Ronald R. Dodge, Jr.
Production Statistician
Master MOUS 2000