I know how to copy a file, but I simply can't figure out how to copy an entire folder. Any help is greatly appreciated.
Printable View
I know how to copy a file, but I simply can't figure out how to copy an entire folder. Any help is greatly appreciated.
This is quite versatile:
In Module:
VB Code:
Option Explicit Private Type SHFILEOPSTRUCT hWnd As Long wFunc As Long pFrom As String pTo As String fFlags As Integer fAborted As Boolean hNameMaps As Long sProgress As String End Type Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long Const FOF_NOCONFIRMATION = &H10 ' Don't prompt the user. Const FOF_NOCONFIRMMKDIR = &H200 ' don't confirm making any needed dirs Const FO_COPY = &H2 Public Function NuCopy(source As String, target As String) As Boolean 'Nucleus 'Copy file(s)/directories from source to destination 'In path of source either file(s) or folder and path of target as folder 'Out: Boolean indicating success If Right(source, 1) = "\" Then source = Left(source, Len(source) - 1) If Len(Dir$(target, vbDirectory)) <> 0 And (Len(Dir$(source, vbDirectory)) <> 0 Or Len(Dir$(target, vbDirectory)) <> 0) Then Dim SHFileOp As SHFILEOPSTRUCT ' structure to pass to the function With SHFileOp .wFunc = FO_COPY .pFrom = source .pTo = target .fFlags = FOF_NOCONFIRMATION Or FOF_NOCONFIRMMKDIR End With NuCopy = (SHFileOperation(SHFileOp) = 0) End If End Function
Usage:
NuCopy("c:\tmp\", "c:\test") ' copy whole folder including subdirectories
NuCopy("c:\tmp\*.*", "c:\test") 'all files in a folder to a different folder
NuCopy("c:\tmp\*.txt", "c:\test") ' copy all text files in a folder
NuCopy("c:\tmp\american.txt", "c:\test") ' copy a file (note can use name to move a single file or filecopy to copy a single file)
Hi,
NuCopy("c:\tmp\*.*", "c:\test") 'all files in a folder to a different folder
This only copies files which are in root folder. What about files in Sub Folders?
My goodness mate where did you dredge this up from? :p
You could try
VB Code:
Name "c:\tmp" As "c:\test"
Failing that I think you'd have to recursively iterate through all subfolders.
Sorry Sorry I made a mistake while copying the code.
My question was
NuCopy("c:\tmp\*.txt", "c:\test") ' copy all text files in a folder
This copies *.txt files for root folder only and not sub folder. Please tell me how do I do that?
You'd need to use iterative recursion.
i.e. loop through all subfolders, and their subfolders, etc., calling that function for each one.
That NuCopy function looks very familiar ... ;)
Here is the original: Copy Entire Folder and it doesn't require any iterations.
BTW, Name ... As ... would simply rename but not move, also it will fail if any file from source folder is open.
You can use Name x As y to move a file from one folder to another.
Perhaps, but not the folder and that is what was asked.
I did post this sample numerous times before:
http://www.vbforums.com/showthread.p...ght=CopyFolder
http://www.vbforums.com/showthread.p...ght=CopyFolder
http://www.vbforums.com/showthread.p...ght=CopyFolder
http://www.vbforums.com/showthread.p...ght=CopyFolder
http://www.vbforums.com/showthread.p...ght=CopyFolder
Also using FSO could be another quite a good option.
Guys here is what we want using FSO. The function Returns a string that contains list of paths of files in root as well as sub folders.
VB Code:
Option Explicit Public Function get_all_directory_files_with_wildcard _ (ByVal tfolder As String, _ ByVal getsubdirs As Boolean, _ ByVal wildcard As String) _ As String Dim objfile As File Dim objfolder As Folder Dim fso As New FileSystemObject Dim kokovar As Variant Dim k As Long Dim wildext As String Dim wildexts As String Dim wildfirst As String Dim wildexte As String Dim wildfirsts As String Dim wildfirste As String Dim examfirst As String Dim examext As String Dim afl_filetext As String kokovar = Split(wildcard, ",") If tfolder <> "" Then For Each objfile In fso.GetFolder(tfolder).Files 'do the stuff we want with the files For k = 0 To UBound(kokovar) wildext = LCase(cutgetExtension(kokovar(k))) wildfirst = LCase(Mid(kokovar(k), 1, Len(kokovar(k)) - Len(wildext) - 1)) If InStr(1, wildext, "*") = 0 Then wildexts = "888NONE888" wildexte = "888NONE888" Else wildexts = Mid(wildext, 1, InStr(1, wildext, "*") - 1) wildexte = Mid(wildext, InStr(1, wildext, "*") + 1, Len(wildext) - InStr(1, wildext, "*")) End If If InStr(1, wildfirst, "*") = 0 Then wildfirsts = "888NONE888" wildfirste = "888NONE888" Else wildfirsts = Mid(wildfirst, 1, InStr(1, wildfirst, "*") - 1) wildfirste = Mid(wildfirst, InStr(1, wildfirst, "*") + 1, Len(wildfirst) - InStr(1, wildfirst, "*")) End If examfirst = LCase(cutgetName(cutfilename(CStr(objfile)))) examext = LCase(cutgetExtension(CStr(objfile))) If wildexts = "888NONE888" Then 'we do not have a wildcard in the extension If wildfirsts = "888NONE888" Then 'we do not have a wildcard neither on the beggining or the 'extension If examfirst = wildfirst And examext = wildext Then afl_filetext = afl_filetext + objfile + vbNewLine End If Else 'we do have a wildcard in the beggining but not in 'the extension If Mid(examfirst, 1, Len(wildfirsts)) = wildfirsts And _ Mid(examfirst, Len(wildfirst) - Len(wildfirste) + 1, Len(wildfirste)) = wildfirste And wildext = examext Then afl_filetext = afl_filetext + objfile + vbNewLine End If End If Else 'we do not have a wildcard in the extension If wildfirsts = "888NONE888" Then 'we do have a wildcard in the beggining but not in the 'extension If Mid(examext, 1, Len(wildexts)) = wildexts And _ Mid(examext, Len(wildext) - Len(wildexte) + 1, Len(wildexte)) = wildexte Then afl_filetext = afl_filetext + objfile + vbNewLine End If Else 'we have a wildcard in both beggining and extension If Mid(examext, 1, Len(wildexts)) = wildexts And _ Mid(examext, Len(wildext) - Len(wildexte) + 1, Len(wildexte)) = wildexte _ And Mid(examfirst, 1, Len(wildfirsts)) = wildfirsts And _ Mid(examfirst, Len(wildfirst) - Len(wildfirste) + 1, Len(wildfirste)) = wildfirste Then afl_filetext = afl_filetext + objfile + vbNewLine End If End If End If 'telos if Next k Next If getsubdirs Then For Each objfolder In fso.GetFolder(tfolder).SubFolders afl_filetext = afl_filetext & get_all_directory_files_with_wildcard(CStr(objfolder), getsubdirs, wildcard) Next End If End If Set fso = Nothing get_all_directory_files_with_wildcard = afl_filetext End Function Public Function cutfilename(ByVal fname As String) As String Dim spos As Integer Dim ffn As String spos = InStrRev(fname, "\") ffn = Mid(fname, spos + 1, Len(fname) - spos) cutfilename = ffn End Function Public Function cutgetExtension(ByVal fname As String) Dim spos As Integer Dim koko As String spos = InStrRev(fname, ".") If spos <> 0 Then koko = Mid(fname, spos + 1, Len(fname) - spos) End If cutgetExtension = koko End Function Public Function cutgetName(ByVal fname As String) Dim spos As Integer Dim koko As String spos = InStrRev(fname, ".") If spos <> 0 Then koko = Mid(fname, 1, spos - 1) End If cutgetName = koko End Function
Usage :
VB Code:
get_all_directory_files_with_wildcard("C:\Documents and Settings\Piyush\Desktop\Resumes", True, "*.htm")
I don't know where are you comming from (idea wise) pbuddy, but to copy folder with all subfolders using FSO all you need is basically ONE line of code (besides declarations):
VB Code:
Private Sub Command1_Click() Dim fso As FileSystemObject Set fso = New FileSystemObject [b]fso.CopyFolder "c:\temp\temp1", "c:\temp\temp3", True[/b] End Sub
Man I wanted this to copy a specific type of files in a folder with sub folder. I know FSO functions.
Man, that is NOT the scope of this thread which clearly states Copying a Folder and nothing more than that. Also, if you read original post (#1) then you would find this:
Quote:
... but I simply can't figure out how to copy an entire folder. ...
pbuddy_8,
Start a new thread. And in future don't try to revive 3 year old threads with different topics.
I didn't even realise that until now ... :bigyello:Quote:
Originally Posted by penagate