Link to home
Start Free TrialLog in
Avatar of ceneiqe
ceneiqeFlag for Australia

asked on

to create macro to save more than one document from different or one location into another folder

i always need some information  in files from other directories to do analysis thus have to a "save as" into another location, ie my c drive in my folder. how to get this done automatically? I understand i can just copy and paste files but the file name that i need comes in a list in excel.
For example:

list in excel

xx-yyyymmdd-12345.docx
xx-yyyymmdd-67890.docx
.
.
.etc

search the above listing in
I:\xxx\  

and then copy them to
 
TO  C:\Users\xxxxxxx\Documents\folder1\folder2\


ie

C:\Users\xxxxxxx\Documents\folder1\folder2\
xx-yyyymmdd-12345.docx

C:\Users\xxxxxxx\Documents\folder1\folder2\
xx-yyyymmdd-67890.docx
Avatar of Rgonzo1971
Rgonzo1971

Hi

pls try
Sub Macro1()

Set myRange = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
For Each c In myRange
SrceFile = "I:\xxx\" & c.Value
DestFile = "C:\Users\xxxxxxx\Documents\folder1\folder2\" & c.Value
FileCopy SrceFile, DestFile

End Sub

Open in new window

Regards
Just a comment on the above solution -- using the FileCopy method, or the Copy method of the File object (part of the FileSystemObject), worked fine for many years, but I have found that in Windows 7, often it doesn't work, because of folder security.  This is particularly likely to be a problem on the C: drive.
Avatar of ceneiqe

ASKER

i encountered error:

Compile Error:
For without Next

OK| Help


How?
hI
Corrected
Sub Macro1()

Set myRange = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
For Each c In myRange
SrceFile = "I:\xxx\" & c.Value
DestFile = "C:\Users\xxxxxxx\Documents\folder1\folder2\" & c.Value
FileCopy SrceFile, DestFile
Next
End Sub

Open in new window

Avatar of ceneiqe

ASKER

there is a run time error '53'
File not found

End|Debug|Help

When i clicked on Debug, "FileCopy SrceFile, DestFile" is highlighted.
Hi,

Have you verified that the paths and the file name in the excel are correct?

Regards
Avatar of ceneiqe

ASKER

Yes the paths are correct.

Example of the files in excel listing as attached.
Q-28286609--compile-doc-in-folde.xlsx
Avatar of ceneiqe

ASKER

To note that the source directory I Drive is a network drive and not a drive in the hard disk.
As a minimum I would check that the filename isn't blank and the path exists

Sub moveme()
Dim strFilename As String
Dim myRange As Range
Dim currRange As Range
Const destFolder As String = "C:\Users\xxxxxxx\Documents\folder1\folder2\"
Const sourceFolder As String = "I:\xxx\"
Set myRange = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
For Each currRange In myRange
strFilename = currRange.Text
'Is filename blank or space
If Trim(strFilename) <> "" Then
'Does path exists
If Dir(sourceFolder & strFilename) <> "" Then
FileCopy sourceFolder & strFilename, destFolder & strFilename
End If
End If
Next currRange
End Sub
Please try this code:-
Sub CopyFiles()

    Const SourceDir As String = "D:\My Documents\Test Folder"
    Const TargetDir As String = "D:\My Documents\Test Folder\Target Folder"
    
    Dim SelFiles() As String                ' File names
    Dim AllFiles As String
    Dim Fso As Object
    Dim FileObject As Object
    Dim Sp() As String
    Dim i As Long

    If Not GetSelectedFiles(SourceDir, SelFiles) Then Exit Sub
    
    For i = 0 To UBound(SelFiles)
        Sp = Split(SelFiles(i), "\")
        AllFiles = AllFiles & Sp(UBound(Sp))
    Next i
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    For Each FileObject In Fso.GetFolder(WithSeparator(SourceDir)).Files
        With FileObject
            If InStr(1, AllFiles, .Name, vbTextCompare) Then
                .Copy WithSeparator(TargetDir)
            End If
        End With
    Next FileObject
    
    Set FileObject = Nothing
    Set Fso = Nothing
End Sub

Open in new window

It uses the 'GetSelectedFiles' procedure to create a FilePicker dialog box. You select the files to copy using Shift-Click and Control-Click to select multiple files from the source directory. You can also use other directories, but the specified source directory will be opened by default. Then you click "Copy" and the selected files are copied to your target directory.

Please set the values of constants Const 'SourceDir' and 'TargetDir' to point at the corresponding actual directories in your computer. Once these two constants are set the code in the attached workbook is ready to work.
EXX-131113-Copy-Seleced-Files.xlsm
hi,

Here's another possibility. Please note that I have only tested this on my machine & not against a folder on a network drive. I have included a macro that will try to create the destination folder if it doesn't exist. I have included debug.print within the code to give feedback messages in the Immediate pane.

Option Explicit
'###change as required (they must end in a backslash)
Private Const SourcefPath As String = "C:\Users\Robert\Downloads\"
Private Const DestfPath As String = "C:\Users\Robert\Downloads\Test1\Test2\"

Sub CopyFilesToTargetDir()
Dim ListOfFilesArr As Variant
Dim fName As String
Dim DestFile As String
Dim fso As Object    'FileSystemObject  'Object
Dim i As Long

    'ListOfFilesArr = Selection
    With ActiveSheet
        '.Range(.Range("A6"), .Range("A" & .Rows.Count).End(xlUp)).Select
        ListOfFilesArr = .Range(.Range("A6"), .Range("A" & .Rows.Count).End(xlUp))
    End With

    ''17/02/2009: sourced from www.rondebruin.nl/folder.htm & would need a reference to MS Scripting Runtime in VBE if it was "early bound"
    ''this overcomes the issue if a file is open which occurs when using "filecopy"
    ''(this was originally... FileCopy SourceFile, IniDestinationFile)
    Set fso = CreateObject("scripting.filesystemobject")

    Call CheckAndCreateFolders(DestfPath)

    For i = LBound(ListOfFilesArr) To UBound(ListOfFilesArr)
        fName = ListOfFilesArr(i, 1)
        With fso
            If .FileExists(SourcefPath & fName) Then
                If .FileExists(DestfPath & fName) Then
                    Debug.Print i & ") Dest file called " & DestfPath & fName & " already existed & has been replaced!"
                End If
                .CopyFile Source:=SourcefPath & fName, Destination:=DestfPath & fName
            Else
                Debug.Print i & ") no source file called " & SourcefPath & fName & "!"
            End If
        End With
    Next i

    Set fso = Nothing
End Sub

Sub CheckAndCreateFolders(sFolderPath As String)
' 14/11/2008, sourced from: _
  http://www.dailydoseofexcel.com/archives/2006/05/24/creating-folders-with-mkdir/
Dim sSubFolder As String
Dim sBaseFolder As String
Dim sTemp As String
Dim ArryDir
Dim i As Long
    If Not Dir(sFolderPath, vbDirectory) = vbNullString Then Exit Sub
    ArryDir = Split(sFolderPath, "\")
    For i = 0 To UBound(ArryDir) - 1
        sBaseFolder = sBaseFolder & ArryDir(i)
        sSubFolder = ArryDir(i + 1)
        'Make sure the base folder is ready to have a sub folder
        'tacked on to the end
        If Right(sBaseFolder, 1) <> "\" Then
            sBaseFolder = sBaseFolder & "\"
        End If
        'Make sure base folder exists
        '### is this better than If Not Dir(strfullpath, vbDirectory) = vbNullString Then DoesFileFolderExist = True
        If Len(Dir(sBaseFolder, vbDirectory)) > 0 Then
            'Replace illegal characters with an underscore
            sTemp = CleanFolderName(sSubFolder)
            'See if already exists: Thanks Dave W.
            If Len(Dir(sBaseFolder & sTemp, vbDirectory)) = 0 Then
                'Use MkDir to create the folder
                MkDir sBaseFolder & sTemp
            End If
        End If
    Next
End Sub
Private Function CleanFolderName(ByVal sFolderName As String) As String
' 14/11/2008, sourced from: _
  http://www.dailydoseofexcel.com/archives/2006/05/24/creating-folders-with-mkdir/
'I changed it from the posted version of "For i = 1 To Len(sFolderName) _
   Select Case Mid$(sFolderName, i, 1) _
   Case "/", "\", ":", "*", "?", "", "|" _ ..." to use "specchararr"
Dim i As Long
Dim sTemp As String
Dim SpecCharArr As Variant
    SpecCharArr = Array("/", "\", ":", "*", "?", "", "|", "#", "%")
    For i = LBound(SpecCharArr) To UBound(SpecCharArr)
        sTemp = Replace(sFolderName, SpecCharArr(i), "_")
    Next i
    CleanFolderName = sTemp
End Function

Open in new window


hth
Rob
Avatar of ceneiqe

ASKER

Hi JSRWilson,

nothing happens when i run the script.
Avatar of ceneiqe

ASKER

Hi broro183,
nothing happens when i run your script.
Avatar of ceneiqe

ASKER

Hi Faustulus,


Source: " I:\name\name1\"

Destination: "C:\Users\name\Documents\folder1\folder2\


Just to highlight that the file name to find to copy can be found in the excel sheet i posted above "example of doc to be copied Q-28286609--compile-doc-in-folde.xlsx"

which means the macro has to find the following file name :
1. MC-20131009-51828.doc
2. SY-20131022-36159.doc

that is in the excel spreadsheet and copy them from :" I:\name\name1\"
to " "C:\Users\name\Documents\folder1\folder2\"
hi ceneiqe,

Did you get any error messages when you tried my code (the CopyFilesToTargetDir sub)?
Does anything appear in the Immediate Pane of the VBE?
Can you please upload a new test file with my code included & modified for your set up?

Rob
Did you step through the code??

Sounds like either the two paths or the Excel data is incorrect.
Avatar of ceneiqe

ASKER

Hi rob

Did you get any error messages when you tried my code (the CopyFilesToTargetDir sub)? = NO

Does anything appear in the Immediate Pane of the VBE? = nothing

Can you please upload a new test file with my code included & modified for your set up?

= ok see attached.Q-28286609--macro-example.xlsm



NOTE**:  
 documents i am finding which can be found in the excel :
"example of doc to be copied Q-28286609--compile-doc-in-folde.xlsx"

which means the macro has to find the following file name :
1. MC-20131009-51828.doc
2. SY-20131022-36159.doc

can be found in the directory " I:\name\name1\"
and this directory has many subfolders where the files can be found.
(see also my comments to Faustulus.)

For example, "MC-20131009-51828.doc" may be sitting in directory  
 I:\name\name1\folder1
"SY-20131022-36159.doc" may be sitting in directory
I:\name\name1\folder2

which is why i use  I:\name\name1\ to have a wider search scope.
You wrote
which means the macro has to find the following file name :
1. MC-20131009-51828.doc
2. SY-20131022-36159.doc
I am reluctant to respond to this request because I feel that you will get tired looking for the same files over and over again. These file names look like they are dated. Therefore, my presumption is that you will look for files with names LIKE those you mention. Therefore, a system would have to be devised by which the program can be instructed how to construct the name of the files to be retrieved.
Of course, your file names not only have a date but also a prefix and a suffix. I am not aware of your having told us anything about how these file names change from day to day, hour to hour or week to week.
The location of both, the source directory and the target directory are very easy to change in the code I have provided. But now I am under the impression that the files might not be in those directories but, possibly, in sub-directories.
Again, the code I have provided allows you to look for the files wherever they are. It is fully functioning and does what you want.
However, I understand that searching for the directory in which the file is hiding can be cumbersome. It is possible to narrow down the search or even eliminate it. However, such a possibility requires that the name of the file is known. You should tell us how the file names are constructed.
Avatar of ceneiqe

ASKER

how the files are constructed:
MC-20131009-51828.doc
MC= initials of the creator
2013 =year
10 =month
09=date
51828= number generated from system

so even if you know the front, it is not possible to determine the back numbers.

thus the easiest i can do is to place all these file names in excel and then run a macro to search these file names in the list and then copy these files from source to destination folder.

NOTE:  i have increased the points from 200 to 300.
Getting very confused as to what you need as the goal post seem to move!

Is this it:


You have a list of (actual) file NAMES in Excel (starting at "A1" ??)
The actual files are in a folder I:\whatever\ BUT buried in a number of sub folders
You need the code to look for the file (unique  I hope) and then copy it to
C:\Users\xxxxxxx\Documents\folder1\folder2\

Can you confirm this is it AND provide the actual paths for the source parent folder and the destination folder.
1. The file names are in an Excel list. OK.
2. Are the files you will put into the list in a single directory? Or could they be in a sub-directory of the given path? And, if so, how many levels deep?
hi Ceneiqe,

I have a reluctance like Faustulus & am confused like JSRWilson.

Your recent statement that the files can be found within sub-directories certainly is not clear in your original post. This is probably why my (& JSRWilson's) code did not work. Can you please try to completely clarify your requirements - is there anything else that is relevant for us to know?

The example file you uploaded with my code doesn't contain the list of files in column A on any of the sheets. This is another reason why my (& JSRWilson's) code suggestions did nothing. Faustulus's code uses a dialog picker to choose the files so it is not reliant on having a list in column A.

What process would you use to put a list of file names into the spreadsheet?
If there is a consistent logic to your process then the logic could be incorporated into the macro & prevent the need for a two step process.

In the mean time, here is an updated version of my code with some more comments & flexibility. However, it does still rely on the file containing a list of file names on the activesheet when the WrapperToCopyFilesToTargetDir Sub is run.


Option Explicit
'###change as required (they must end in a backslash)
Private Const SourcefPath As String = "I:\Mitchell Anderson\Yes\"
Private Const DestfPath As String = "C:\Users\Z009080\Documents\__STORAGE\Yes Comments\"
'Private Const SourcefPath As String = "C:\Users\Robert\Downloads\"
'Private Const DestfPath As String = "C:\Users\Robert\Documents\Excel\"

Sub WrapperToCopyFilesToTargetDir()
Dim ListOfFilesArr As Variant
Dim fName As String
Dim DestFile As String
Dim FSO As object 'Scripting.FileSystemObject    'Object
Dim fsoSubFldr As object 'Scripting.Folder    'object
Dim i As Long

    'ListOfFilesArr = Selection
    With ActiveSheet
        '.Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp)).Select
        If .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp)).Address = "$A$1" And Len(.Range("A1")) = 0 Then
            MsgBox "No list of files found on the active sheet therefore macro ending!"
            Exit Sub
        Else
            ListOfFilesArr = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp))
        End If
    End With

    ''17/02/2009: sourced from www.rondebruin.nl/folder.htm & would need a reference to MS Scripting Runtime in VBE if it was "early bound"
    ''this overcomes the issue if a file is open which occurs when using "filecopy"
    ''(this was originally... FileCopy SourceFile, IniDestinationFile)
    Set FSO = CreateObject("scripting.filesystemobject")

    Call CheckAndCreateFolders(DestfPath)

    For i = LBound(ListOfFilesArr) To UBound(ListOfFilesArr)
        fName = ListOfFilesArr(i, 1)
        'check the top level folder first
        If Not CheckFileExistenceAndCopyFile(FSO, SourcefPath, fName) Then
            'loop through each of the subfolders
            For Each fsoSubFldr In FSO.GetFolder(SourcefPath).SubFolders
                If CheckFileExistenceAndCopyFile(FSO, fsoSubFldr.Path, fName) Then
                    Exit For
                End If
            Next fsoSubFldr
        Else
            Debug.Print "Source file (" & SourcefPath & fName & ") existed in the top level folder"
        End If
    Next i

    Set FSO = Nothing
End Sub

Function CheckFileExistenceAndCopyFile(FSO As Object, fPath As String, fName As String) As Boolean
'Obj: check that a file exists, copy to destination (defined by module level constant)
'& provide feedback via the Immediate pane of the VBE.
    With FSO
        If .FileExists(fPath & fName) Then
            If .FileExists(DestfPath & fName) Then
                Debug.Print "Dest file called " & DestfPath & fName & " already existed & has been replaced!"
            End If
            .CopyFile Source:=fPath & fName, Destination:=DestfPath & fName
            CheckFileExistenceAndCopyFile = True
        Else
            Debug.Print "no source file called " & fPath & fName & "!"
        End If
    End With
End Function

Sub CheckAndCreateFolders(sFolderPath As String)
' 14/11/2008, sourced from: _
  http://www.dailydoseofexcel.com/archives/2006/05/24/creating-folders-with-mkdir/
Dim sSubFolder As String
Dim sBaseFolder As String
Dim sTemp As String
Dim ArryDir
Dim i As Long
If Not Dir(sFolderPath, vbDirectory) = vbNullString Then Exit Sub    ''ERROR
    ArryDir = Split(sFolderPath, "\")
    For i = 0 To UBound(ArryDir) - 1
        sBaseFolder = sBaseFolder & ArryDir(i)
        sSubFolder = ArryDir(i + 1)
        'Make sure the base folder is ready to have a sub folder
        'tacked on to the end
        If Right(sBaseFolder, 1) <> "\" Then
            sBaseFolder = sBaseFolder & "\"
        End If
        'Make sure base folder exists
        '### is this better than If Not Dir(strfullpath, vbDirectory) = vbNullString Then DoesFileFolderExist = True
        If Len(Dir(sBaseFolder, vbDirectory)) > 0 Then
            'Replace illegal characters with an underscore
            sTemp = CleanFolderName(sSubFolder)
            'See if already exists: Thanks Dave W.
            If Len(Dir(sBaseFolder & sTemp, vbDirectory)) = 0 Then
                'Use MkDir to create the folder
                MkDir sBaseFolder & sTemp
            End If
        End If
    Next
End Sub

Private Function CleanFolderName(ByVal sFolderName As String) As String
' 14/11/2008, sourced from: _
  http://www.dailydoseofexcel.com/archives/2006/05/24/creating-folders-with-mkdir/
'I changed it from the posted version of "For i = 1 To Len(sFolderName) _
   Select Case Mid$(sFolderName, i, 1) _
   Case "/", "\", ":", "*", "?", "", "|" _ ..." to use "specchararr"
Dim i As Long
Dim sTemp As String
Dim SpecCharArr As Variant
    SpecCharArr = Array("/", "\", ":", "*", "?", "", "|", "#", "%")
    For i = LBound(SpecCharArr) To UBound(SpecCharArr)
        sTemp = Replace(sFolderName, SpecCharArr(i), "_")
    Next i
    CleanFolderName = sTemp
End Function

Open in new window

hth
Rob
Avatar of ceneiqe

ASKER

Getting very confused as to what you need as the goal post seem to move!

Is this it:

You have a list of (actual) file NAMES in Excel (starting at "A1" ??)
The actual files are in a folder I:\whatever\ BUT buried in a number of sub folders
You need the code to look for the file (unique  I hope) and then copy it to
C:\Users\xxxxxxx\Documents\folder1\folder2\

Can you confirm this is it AND provide the actual paths for the source parent folder and the destination folder.


You have a list of (actual) file NAMES in Excel (starting at "A1" ??) = YES. (only  the name ie without the ".doc" extension

The actual files are in a folder I:\whatever\ BUT buried in a number of sub folders = YES

You need the code to look for the file (unique  I hope) and then copy it to
C:\Users\xxxxxxx\Documents\folder1\folder2\   =YES the code is unique. Yes right copy to  the location mentioned.

Source Folder: I:\Mitchell Anderson\Yes\

Destination Folder: "C:\Users\Z009080\Documents\__STORAGE\Yes Comments\
Avatar of ceneiqe

ASKER

1. The file names are in an Excel list. OK.
2. Are the files you will put into the list in a single directory? Or could they be in a sub-directory of the given path? And, if so, how many levels deep?

1. The file names are in an Excel list. OK.  = YES

2. Are the files you will put into the list in a single directory? Or could they be in a sub-directory of the given path? And, if so, how many levels deep? = The file names are in an excel list.
This excel spreadsheet is located in C:\Users\Z009080\Documents\__STORAGE\Yes Comments\
Avatar of ceneiqe

ASKER

I have a reluctance like Faustulus & am confused like JSRWilson.

Your recent statement that the files can be found within sub-directories certainly is not clear in your original post. This is probably why my (& JSRWilson's) code did not work. Can you please try to completely clarify your requirements - is there anything else that is relevant for us to know?
= i think i have clarified in the 2 previous posts

The example file you uploaded with my code doesn't contain the list of files in column A on any of the sheets. This is another reason why my (& JSRWilson's) code suggestions did nothing. Faustulus's code uses a dialog picker to choose the files so it is not reliant on having a list in column A.
= sorry perhaps i wasn't clear enough.
i did mention in my first post that the names of files are listed in excel.
and i think you misinterpreted my example file. i was trying to say that those file names can be found in the excel spreadsheet in column A starting from cell A1 and that the names are without the file extension ie. MC-20131009-51828 and not MC-20131009-51828.doc or MC-20131009-51828.docx

What process would you use to put a list of file names into the spreadsheet?
If there is a consistent logic to your process then the logic could be incorporated into the macro & prevent the need for a two step process.
=i manually extracted from another excel file and paste them in the spreadsheet.

In the mean time, here is an updated version of my code with some more comments & flexibility. However, it does still rely on the file containing a list of file names on the activesheet when the WrapperToCopyFilesToTargetDir Sub is run.
=thanks, i will test it.
The most vital piece of information doesnt seem to be here.

How many levels deep can the file be buried in the sub folders. That is can subfolders have subfolders or is there a parent folder with a lot of subfolders none of which contain further sub folders.

If you ned to build a recursive search of nested sub folders this is A. Complex B. Slow
Hmmm, my code will only match exact file names & it needs the extensions to be included.

JSRWilson makes a good point, my last lot of code will only look at the first nested level of sub-folders.

=i manually extracted from another excel file and paste them in the spreadsheet.
Is there a consistent logic to how you extract them?
For example, is it all of the "external links" within the other file?

Rob
Ceneiqe,
I truly admire your effort to answer all our questions, giving each of us our own reply. Thank you.
The current (and new) bone of contention is the location of the files to be found (like MC-20131022 58123.docx). The code involved in looking for a file at a known location is vastly different from that required for finding that same file in an unknown folder. I don't think that you actually said that there are sub-folders where the files might be, but you wrote something that gave the impression that there might be. Please try to give us this information as precisely as possible.
Avatar of ceneiqe

ASKER

The most vital piece of information doesnt seem to be here.

How many levels deep can the file be buried in the sub folders. That is can subfolders have subfolders or is there a parent folder with a lot of subfolders none of which contain further sub folders.

If you ned to build a recursive search of nested sub folders this is A. Complex B. Slow

yes, subfolders in the source directory can have subfolders.
currently, there are 13 subfolders in  

I:\Mitchell Anderson\Yes\

that is

I:\Mitchell Anderson\Yes\subfolder 1
I:\Mitchell Anderson\Yes\subfolder 2
.
.
.
I:\Mitchell Anderson\Yes\subfolder 13


user can create as many subfolders as possible , ie.
I:\Mitchell Anderson\Yes\subfolder 14
I:\Mitchell Anderson\Yes\subfolder 15
.
.
etc.

the level stops here, that is it will NOT have further level than the above,that is,
you will NOT have

I:\Mitchell Anderson\Yes\subfolder 1\sub-subfolder 1
I:\Mitchell Anderson\Yes\subfolder 1\sub-subfolder 2
.
.
etc.
Avatar of ceneiqe

ASKER

Hmmm, my code will only match exact file names & it needs the extensions to be included.

JSRWilson makes a good point, my last lot of code will only look at the first nested level of sub-folders.


=i manually extracted from another excel file and paste them in the spreadsheet.


Is there a consistent logic to how you extract them?
For example, is it all of the "external links" within the other file?

Rob

No consistent logic on my extraction, that is why i manually place the file name in the excel spreadsheet and base on the information given in the excel spreadsheet, the macro will search and copy the files from the source directory to the designated directory.
Avatar of ceneiqe

ASKER

Ceneiqe,
I truly admire your effort to answer all our questions, giving each of us our own reply. Thank you.
The current (and new) bone of contention is the location of the files to be found (like MC-20131022 58123.docx). The code involved in looking for a file at a known location is vastly different from that required for finding that same file in an unknown folder. I don't think that you actually said that there are sub-folders where the files might be, but you wrote something that gave the impression that there might be. Please try to give us this information as precisely as possible.


Ok I think you meant you can't file name in my excel attachment in my post ID: 39661646
"Q-28286609--macro-example.xlsm" - yes, sorry i forgot to place the file names in the worksheet.

To avoid confusion, pls see updated file.
Q-28286609--macro-example-UPDATE.xlsm

You will see MC-20131009-51828 and SY-20131022-36159 in Cell A1 and Cell A2 respectively.

Macro should find file names "MC-20131009-51828.doc" "SY-20131022-36159.doc" (the file format is all in .doc) in the following source directly

I:\Mitchell Anderson\Yes\

where it should also look into its subfolders
I:\Mitchell Anderson\Yes\subfolder 1
I:\Mitchell Anderson\Yes\subfolder 2
.
.
.
I:\Mitchell Anderson\Yes\subfolder 13
etc.


pls also see my comments in ID: 39689272


The reason why "MC-20131009-51828.doc" is not stated in Cell A1 but only "MC-20131009-51828" is because "MC-20131009-51828" is a file name derived from another database and for me to copy and paste "MC-20131009-51828.doc" would need another extra step from me meaning i need to add ".doc" in B1 and so on with the formula in C1"=CONCATENATE(A1,B1)" to get "MC-20131009-51828.doc"
so since i am looking for file name in the source directory, i would think the extension .doc is not important.
However, if it is better for me to include the extension to run the macro, pls let me know. I will add the extra column.


Thus, for your info "MC-20131009-51828.doc" can be found in
I:\Mitchell Anderson\Yes\subfolder 6
ASKER CERTIFIED SOLUTION
Avatar of John Wilson
John Wilson
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of ceneiqe

ASKER

Hi JSRWilson

i tried and the following but error"ambiguous name detected: moveme"
That could only happen if you have some other code called "moveme"

Try changing Sub moveme()

TO (for example)

Sub UniqueMove()
Avatar of ceneiqe

ASKER

Ok i have changed the name.
Nothing happens when i run the macro.
No idea - it works perfectly here.
Avatar of ceneiqe

ASKER

i place the code in the following code format for easy reference in future.

Sub moveme2()
Dim strFilename As String
Dim myRange As Range
Dim currRange As Range
Dim lngPos As Long
Dim b_Found As Boolean
Dim FSO As Object, ofld As Object, oFile As Object, osub As Object
On Error Resume Next
'Change the paths here!!
Const destFolder As String = "C:\Users\XXXX\Documents\__XXX\XXXX\"
Const sourceParentFolder As String = "I:\XXX\XXX\"


Set FSO = CreateObject("Scripting.FileSystemObject")
'check destination exists
If Not FSO.FolderExists(FSO.getFolder(destFolder)) Then
MsgBox "The destination folder does not exist!", vbCritical
Exit Sub
End If
'check source parent exists
Set ofld = FSO.getFolder(sourceParentFolder)
If FSO.FolderExists(ofld) Then
Set myRange = Range(Range("A1"), Range("A" & Rows.count).End(xlUp))
For Each currRange In myRange
b_Found = False
strFilename = currRange.Text
'Is filename blank or space
If Trim(strFilename) <> "" Then
'Parent Folder

For Each oFile In ofld.Files
If UCase(oFile.Name) Like UCase(strFilename) & "*" Then
lngPos = InStrRev(oFile.Name, ".")
If UCase(Left(oFile.Name, (lngPos - 1))) = UCase(strFilename) Then
FileCopy oFile.Path, destFolder & oFile.Name
b_Found = True
Exit For
End If
End If
Next oFile

'Sub Folders
If b_Found = False Then
For Each osub In FSO.getFolder(sourceParentFolder).SubFolders
For Each oFile In osub.Files
If UCase(oFile.Name) Like UCase(strFilename) & "*" Then
lngPos = InStrRev(oFile.Name, ".")
If UCase(Left(oFile.Name, (lngPos - 1))) = UCase(strFilename) Then
FileCopy oFile.Path, destFolder & oFile.Name
Exit For
End If
End If
Next oFile
Next osub
End If 'already found
End If
Next currRange
Else
MsgBox "The parent folder does not exist!", vbCritical
End If 'source folder exists?
End Sub

Open in new window

Avatar of ceneiqe

ASKER

Yes JSRWilson you are right, i have a typo on the folder - but it also exists so that's why nothing happens.

your code is ok.