Solved

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

Posted on 2013-11-05
40
326 Views
Last Modified: 2013-12-05
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
0
Comment
Question by:ceneiqe
  • 19
  • 7
  • 4
  • +3
40 Comments
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 39626575
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
0
 
LVL 31

Expert Comment

by:Helen_Feddema
ID: 39627776
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.
0
 

Author Comment

by:ceneiqe
ID: 39629483
i encountered error:

Compile Error:
For without Next

OK| Help


How?
0
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 39629512
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

0
 

Author Comment

by:ceneiqe
ID: 39629604
there is a run time error '53'
File not found

End|Debug|Help

When i clicked on Debug, "FileCopy SrceFile, DestFile" is highlighted.
0
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 39629631
Hi,

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

Regards
0
 

Author Comment

by:ceneiqe
ID: 39632507
Yes the paths are correct.

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

Author Comment

by:ceneiqe
ID: 39632511
To note that the source directory I Drive is a network drive and not a drive in the hard disk.
0
 
LVL 23

Expert Comment

by:JSRWilson
ID: 39644595
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
0
 
LVL 14

Expert Comment

by:Faustulus
ID: 39646839
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
0
 
LVL 10

Expert Comment

by:broro183
ID: 39647474
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
0
 

Author Comment

by:ceneiqe
ID: 39661538
Hi JSRWilson,

nothing happens when i run the script.
0
 

Author Comment

by:ceneiqe
ID: 39661540
Hi broro183,
nothing happens when i run your script.
0
 

Author Comment

by:ceneiqe
ID: 39661553
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\"
0
 
LVL 10

Expert Comment

by:broro183
ID: 39661599
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
0
 
LVL 23

Expert Comment

by:JSRWilson
ID: 39661630
Did you step through the code??

Sounds like either the two paths or the Excel data is incorrect.
0
 

Author Comment

by:ceneiqe
ID: 39661646
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.
0
 
LVL 14

Expert Comment

by:Faustulus
ID: 39661862
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.
0
 

Author Comment

by:ceneiqe
ID: 39665080
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.
0
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 
LVL 23

Expert Comment

by:JSRWilson
ID: 39665191
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.
0
 
LVL 14

Expert Comment

by:Faustulus
ID: 39665206
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?
0
 
LVL 10

Expert Comment

by:broro183
ID: 39665485
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
0
 

Author Comment

by:ceneiqe
ID: 39666075
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\
0
 

Author Comment

by:ceneiqe
ID: 39666086
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\
0
 

Author Comment

by:ceneiqe
ID: 39666114
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.
0
 
LVL 23

Expert Comment

by:JSRWilson
ID: 39666246
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
0
 
LVL 10

Expert Comment

by:broro183
ID: 39666924
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
0
 
LVL 14

Expert Comment

by:Faustulus
ID: 39667060
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.
0
 

Author Comment

by:ceneiqe
ID: 39689272
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.
0
 

Author Comment

by:ceneiqe
ID: 39689277
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.
0
 

Author Comment

by:ceneiqe
ID: 39689302
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
0
 
LVL 23

Accepted Solution

by:
JSRWilson earned 300 total points
ID: 39689326
See if this gets you closer

Obviously change the paths for the source / destination folders

Sub moveme()
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\John\Documents\folder1\"
Const sourceParentFolder As String = "C:\Users\John\Desktop\Files\"

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
0
 

Author Comment

by:ceneiqe
ID: 39691725
Hi JSRWilson

i tried and the following but error"ambiguous name detected: moveme"
0
 
LVL 23

Expert Comment

by:JSRWilson
ID: 39691825
That could only happen if you have some other code called "moveme"

Try changing Sub moveme()

TO (for example)

Sub UniqueMove()
0
 

Author Comment

by:ceneiqe
ID: 39694778
Ok i have changed the name.
Nothing happens when i run the macro.
0
 
LVL 23

Expert Comment

by:JSRWilson
ID: 39694810
No idea - it works perfectly here.
0
 

Author Comment

by:ceneiqe
ID: 39697712
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

0
 

Author Comment

by:ceneiqe
ID: 39697714
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.
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Entering a date in Microsoft Access can be tricky. A typo can cause month and day to be shuffled, entering the day only causes an error, as does entering, say, day 31 in June. This article shows how an inputmask supported by code can help the user a…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
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…

708 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

15 Experts available now in Live!

Get 1:1 Help Now