• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Excel code to copy 1 closed file reside in particular folder to multiple location without prompt

Dear All,

I Pray.. God Bless to you for your complete your dreams.

I want Excel VBA code to copy 1 closed file reside in particular folder to multiple location without prompt over write.

I already searched in web sites but nothing found related to my requirement.


Hope there are some way there..

Regards,

CHirag Raval
 
Like the code that Ron de Bruin used in the link, I used the fso object. Howsoever, I normally try to teach the user more by doing things differently. My fso object uses early binding so you need to set in the Visual Basic Editor (VBE) the Reference as I commented. This lets intellisense work for you. It just takes 4 clicks to add it.

Change the value of fn, file to copy, and the array of paths/folders in the array to suit.

I used MD in the Shell() so that subfolder(s) can be created if needed. I could have used fso's BuildPath but I find it unreliable and does not make more than one subfolder as does VBA's standard MkDir().

Code:
Sub CopyAndOverWriteFile2ManyFolders()
  'Tools > References > Microsoft Scripting Runtime > OK
  Dim fso As New FileSystemObject, f As Object
  Dim p$, fn$, a, e
  With fso
    p = Environ("temp") & "\" 'Set as you like.
    If Not .FolderExists(p) Then Exit Sub
  
    'An array of target folders to copy to, change to suit.
    a = Array(p & "1 1\", p & "2 2\", "c:\myfiles\excel\filefolder\")
  
    'Make a test file for the examle. Set fn to suit.
    fn = p & "Hello World.txt"
    .CreateTextFile(fn, True).WriteLine ("Hello World!")
    'Set f = .CreateTextFile(fn, True)
    'f.WriteLine ("Hello World!")
    'f.Close
    If Not .FileExists(fn) Then Exit Sub
  
    'Iterate folders and copy fn with overwrite.
    For Each e In a
      'Make folder(s) if needed. Handles more than one subfolder.
      Shell "cmd /c md " & """" & e & """", vbHide
      If Not .FolderExists(e) Then GoTo NextE
      .CopyFile fn, e & .GetFile(fn).Name, True
NextE:
    Next e
  End With
  Set fso = Nothing
End Sub
[/code
 
Last edited:
Dear Sir @Kenneth Hobson ,

Many thanks for give above new code

though FSo is new element to understand for me but i can uderstand its power to what it can do for you..as jut "With fso" & if given just "." (dot) , itelisens present to help you with what you can do with fso..

but though I many try on your above amazing code..its create text file in given path..& also folders ..i(i till need to repeat this code for understanding)
as you describe in your post no 3,

Code:
".CopyFile fn, e & .GetFile(fn).Name, True
i can not copy my 1 folder's file to many diffrent drives paths

can you help to just make this easy?
for just copy can i commented all above staement & codding
on above ?

again many thanks to realise that what can FSO can do..

please help..

Regards,
Chirag Raval
 
Are you using MAC or PC? Did you get the reference added ok?

Post your code or file so I can see if there is a syntax error.

As-is, once the reference was added, the code should have created the folders and copied the created fn to them.

In the production version, all you had to do was change fn value and the array of folder name values.
 
Dear Sir @Kenneth Hobson ,

Thank you very much
i already practice & study many times your this code
i slowly in touch of hidden power of FSO, & i try to understand your code as below

Code:
Sub CopyOverWriteFile2ManyFolders()
'Tools > References > Microsoft Scripting Runtime > OK
 
‘This code Copy existing folder’s existing file in  many folders you can also decide that if target folder
‘not exist code can make that folder & copy  you file also on that folder
 
‘THIS PROCEDGURE USE 3 ASPECT  OF CODDING
 
(1)    Fso (File System Object)-‘core of this procedure
(2)    Array
(3)    Shell Commands (to work with Dos commands to create folder/file)
 
Sub CopyCreateOverWriteFile2ManyFolders ()
Dim fso As New FileSystemObject
Dim F As Object
Dim p As String
Dim fn As String,
Dim a as variant ‘– A Variable for array , named a , should be variable type as variant
Dim e as variant  ‘- e variable for element of array, for file , -should by variable  type as variant
  ‘++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  With fso
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
‘(1) set path to existing folder  in which , your existing file reside  which you want to copy 
 
p = "E:\BUYER MASTER\" & "\" 'Set as you like.
  If Not .FolderExists(p) Then Exit Sub      ‘pending for  understand  what is use of this statement
 
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'(2)  An array of target folders (to copy or create new folder named in array ), change to suit.-
 
‘Please Note:-  If folders you mentioned in below array , if not exist  in your path & if Shell command ‘(below )is uncommented, then that folder (not exist anywhere (on path “p” above ) create by shell ‘command & copy your file in that folders also,
 
‘ if shell command commented,  then copy your file only  in just existing folder in array without make ‘any folder  mentioned in array, if any folder mentioned in array , not existing anywhere in path (p) ‘nothing do  code exit from sub 
 
‘you can decide  this..  what you want to do …base on shell command commented or uncommented
  '  a = Array(p & "1 1\", p & "2 2\", "C:\Users\admin\Desktop\")-Original code
    a = Array(p & "myfold1 \", p & "myfold2 \", "C:\Users\admin\Desktop\myfol3\")- ‘modify as your desire
      ‘++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  '(3)  Below code is for work on file ..if you want to create new file , if file name not exist in folder
          ‘ Then remove comments on below code,  OR  if you do not want to create new file if file not exist
          ‘ in folder  then  comment this file creation code.
 
'Make a test file for the example. Set fn to suit.
  fn = p & "test.txt" '-ORIGINAL CODE (variable p used for path)
 
      ‘THERE ARE TWO TYPS OF CODE STYLE YOU CAN USE TO CREATE FILE WITH HELP OF FSO
      ‘please focus on first starting dot (“.”) that reference to its parent - FSO
 
                                                                            ‘(1)
'  .CreateTextFile(fn, True).WriteLine ("Hello World!") '-original code For create new file you can ‘comment this code if you wish to create new file with below mentioned 2nd style
 
                                                                            ‘OR (2)
  'Set f = .CreateTextFile(fn, True) ‘-ORIGINAL CODE to create file through FSO,
                                                            ‘note that variable f  assigned value now  as whole process of
                                                          ‘ new file object creation under FSO &  after create file by FSO
                                                            ‘Now you can give reference of this object  named f to do more
                                                            ‘on this file object
 
  'f.WriteLine ("Hello World!") ‘ what you want to write in your newly created file
  'f.Close’ file close after write something there
  If Not .FileExists(fn) Then Exit Sub  ‘pending for  understand  what is use of this statement
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
'(4)  Code for create folder & create file in arrayed path
‘If folder name not found in array then below code create new folder in that path , based on above ‘conditions…
'Iterate folders and copy fn with overwrite. (without alert message of Overwrite from excel)
  For Each e In a    ‘ Each element  e (file)  of array named a,
      'Make folder(s) if needed. Handles more than one subfolder.
 
' Shell "cmd /c md " & """" & e & """", vbHide    'ORIGINAL CODE-Command prompt triggered by 
                                                                      ‘shell command to create folder first & then create new file
                                                                      ‘there
 
If Not .FolderExists(e) Then GoTo NextE  ‘  this is optional & pending for understand…need help What to do here & what is relation to below code?
‘++++++++++++++++++++++++++++++++++++++++++++++++++++++++’
‘(5) if you want to just copy & overwrite your existing file then below  is for you
   
      .CopyFile fn, e & .GetFile(fn).Name, True
NextE:
    Next e
  End With
  Set fso = Nothing ‘here ,end  FSO’s work & gracefully dissolve this variable in universe 
End Sub

please mentione as reply/post if somewhere my mistake of understand this whole code

also please help to understand for in my above code..

i part whole code as '+++++ between diffrent aspects of whole code
is your code is whole fro start to end , is some relation or dependancy between where i partitioned? is "if something not exist then exist sub"
joint /concatenationg previous to next process ?

i take from your code that copy & overwrite existing file in existing folder as below.
 
Dear Sir @Kenneth Hobson

i trimmed your above code as below for just copy/overwrite purpose,

Code:
Sub CopyOverWriteFile2ManyFolders()
  'Tools > References > Microsoft Scripting Runtime > OK
Dim fso As New FileSystemObject
Dim F As Object
Dim p As String
Dim fn As String
Dim a As Variant
Dim e As Variant
  With fso
'+++++++++++++++++++++++++++++++++++
  p = "E:\BUYER MASTER\" & "\" 'Set as you like
  If Not .FolderExists(p) Then Exit Sub
  '+++++++++++++++++++++++++++++++++++++++++++++
  a = Array(p & "myfold1 \", p & " myfold2 \", "C:\Users\admin\Desktop\")
'++++++++++++++++++++++++++++++++++++++++++++++++ 
fn = p & "SUITING-BUYER MASTER.xlsx"
'++++++++++++++++++++++++++++++++++++++++++++++++
For Each e In a    ' Each element  e (file)  of array named a,
  .CopyFile fn, e & .GetFile(fn).Name, True
'  If Not .FolderExists(e) Then GoTo NextE
'NextE:
    Next e
  End With
  Set fso = Nothing
End Sub

but code stuck on " .CopyFile fn, e & .GetFile(fn).Name, True"
Runtime Error 76 Path not found....

hope your co-operation

Regards,
Chirag Raval
 
You added a 2nd backslach "\" to your p value. Environ("temp") returns the temp folder's path without that character which was why I added it.

Your main problem is probably what it says. You commented out the Shell() routine where I use MD to make directories. Of course even that would fail if say E: drive in your case does not exit.

Of course after Shell() I checked that the path to copy to was created and exits. Had you not removed it, it would have simply skipped that copy and tried the others.
 
Dear Sir @Kenneth Hobson,

Okay i modify as needed

Code:
Sub CopyOverWriteFile2ManyFolders()
  'Tools > References > Microsoft Scripting Runtime > OK
Dim fso As New FileSystemObject
Dim F As Object
Dim p As String
Dim fn As String
Dim a As Variant
Dim e As Variant
With fso
p = "E:\BUYER MASTER\"  'Set as you like
        If Not .FolderExists(p) Then Exit Sub
 
 
a = Array(p & "j1\", p & "j2\", "C:\Users\admin\Desktop\") '2 folders in above path(p)  & 1 folder on desktop
 
 
fn = p & "SUITING-BUYER MASTER.xlsx"
        If Not .FileExists(fn) Then Exit Sub
 
 
For Each e In a    ' Each element  e (file)  of array named a,
 
    Shell "cmd /c md " & """" & e & """" 'vbHide' (VBhide is optional if folder/file you want make hidden)
 
        If Not .FolderExists(e) Then GoTo NextE
 
            .CopyFile fn, e, True & .GetFile(fn).Name, True
                 
NextE:
    Next e
 
  End With
  Set fso = Nothing
End Sub

But in first run, its create only folders if not exist there, without copy my file
if i run second time this macro, then copy my files on that folders.

I also comment on "vbhide" because it cannot delete folders created by
this macro.

Please guide how to modify this code to copy files also in newly created folders in first run

Regards,
Chirag Raval
 
I have seen that problem before. I think it has to do with the shell instance while the macro is running.

IF you know your data AND you know that only one level subfolder needs to be created, VBA.MkDir is the better route.

The last routine shows how to do a DelTree to remove folders/directories (RD). Be VERY careful using it. If you send c:\, all of your files and folders would be deleted. It is called shooting one's self in the foot.

Code:
Sub CopyAndOverWriteFile2ManyFolders()
  'Tools > References > Microsoft Scripting Runtime > OK
  'Dim fso As New FileSystemObject
  Dim fso As Object
  Dim f As Object, wo As Object
  Dim p$, fn$, a, e, t$

  Set fso = CreateObject("Scripting.FileSystemObject")
  Set wo = CreateObject("WScript.Shell")

  With fso
    p = Environ("temp") & "\" 'Set as you like.
    If Not .FolderExists(p) Then Exit Sub
 
    'An array of target folders to copy to, change to suit.
    a = Array(p & "1 1\", p & "2 2\", "c:\myfiles\excel\filefolder\")
 
    'Make a test file for the examle. Set fn to suit.
    'fn = p & "Hello World.txt"
    '.CreateTextFile(fn, True).WriteLine ("Hello World!")
    'Set f = .CreateTextFile(fn, True)
    'f.WriteLine ("Hello World!")
    'f.Close
    fn = p & "1.txt"
    If Not .FileExists(fn) Then Exit Sub
 
    'Iterate folders and copy fn with overwrite.
    For Each e In a
      'Make folder(s) if needed. Handles more than one subfolder.
      'Shell "cmd /c md " & """" & e & """", vbHide
      'wo.Exec ("cmd /c md " & """" & e & """")
      If Dir(e, vbDirectory) = "" Then MkDir e
      If Not .FolderExists(e) Then GoTo NextE
      'If Dir(e, vbDirectory) = "" Then GoTo NextE
      t = CStr(e) & .GetFile(fn).Name
      .CopyFile fn, t, True
NextE:
    Next e
  End With

  Set fso = Nothing
End Sub

Sub DelTrees()
  Dim a, e, p$
  p = Environ("temp") & "\" 'Set as you like.
  a = Array(p & "1 1\", p & "2 2\", "c:\myfiles\excel\filefolder\")
  For Each e In a
    Shell "cmd /c rd /s /q " & """" & e & """", vbHide
  Next e
End Sub
Of course the best method is the shell's MD command. The problem with Shell() and WScript.Shell use of MD is that they they are still running while VBA contiues to execute the following code. Event DoEvents won't solve the problem. So, what is one to do? Call the API ShellExecuteWait() to well, wait for the shell to close before passing control back to the calling application. e.g.
Code:
'http://www.mvps.org/access/api/api0004.htm
      ShellWait "cmd /c md " & """" & e & """", vbHide
 
Last edited:
Dear Sir @Kenneth Hobson ,

Great, Amazing, Work like a charm..Supre Code..as per expected..we can Make directory & copy file in it in one run only.. also thanks for give additional code for remove directory tree with its all files.

I adjust your above code as per my small suitable situation (Only need Copy/Overwrite existing files on multiple locations without need to create folders anywhere,of course, if folder already exist its just copy /overwrite file there ..) as per below & its work perfact.

Your Mkdir , vbDirecotry & Cstr(e) commands rocks in below this code without any problem

Code:
Sub CopyOverWriteFile2ManyFolders()
  'Tools > References > Microsoft Scripting Runtime > OK
Dim fso As New FileSystemObject
Dim f As Object
Dim p As String
Dim fn As String
Dim a As Variant
Dim e As Variant
Dim t As Variant
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set wo = CreateObject("WScript.Shell")
  With fso
 
  p = "E:\BUYER MASTER\"  'Set as you like
        If Not .FolderExists(p) Then Exit Sub
'An array of target folders to copy to, change to suit.
'2 folders in above path(p)  & 1 folder on desktop
   
  a = Array(p & "j1\", p & "j2\", "C:\Users\admin\Desktop\")
   
  fn = p & "SUITING-BUYER MASTER.xlsx"
        If Not .FileExists(fn) Then Exit Sub
'Iterate folders and copy fn with overwrite.
' Each element  e (file)  of array named a
   
  For Each e In a
    If Dir(e, vbDirectory) = "" Then MkDir e
      If Not .FolderExists(e) Then GoTo NextE
      'If Dir(e, vbDirectory) = "" Then GoTo NextE
    t = CStr(e) & .GetFile(fn).Name
      .CopyFile fn, t, True
NextE:
    Next e
  End With
  Set fso = Nothing
End Sub
2nd part of As per your post no 11 ,Shallwait-i already also try it on
shell but its raised error
Code:
"For Each e In a
    Shellwait "cmd /c rd /s /q " & """" & e & """", vbHide
  Next e

Though shell & shelwait are optional & another style of code for our this aim,it will be also very helpfull to us that how can we sucessfully apply Shellwait (Call the API ShellExecuteWait() ) in as above your code as just for as a working example.

hope your little help..

Regards,
Chirag Raval
 
Back
Top