Copying a Folder

[gasfumes]

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.

[Nucleus]

This is quite versatile:

In Module:

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)

[pbuddy_8]

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?

[penagate]

My goodness mate where did you dredge this up from?

You could try

Name "c:\tmp" As "c:\test"

Failing that I think you'd have to recursively iterate through all subfolders.

[pbuddy_8]

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?

[penagate]

You'd need to use iterative recursion.

i.e. loop through all subfolders, and their subfolders, etc., calling that function for each one.

[RhinoBull]

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.

[penagate]

You can use Name x As y to move a file from one folder to another.

[RhinoBull]

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

[RhinoBull]

Also using FSO could be another quite a good option.

[pbuddy_8]

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.

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 :

get_all_directory_files_with_wildcard("C:\Documents and Settings\Piyush\Desktop\Resumes", True, "*.htm")

[RhinoBull]

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):

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

[pbuddy_8]

Man I wanted this to copy a specific type of files in a folder with sub folder. I know FSO functions.

[RhinoBull]

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:

... but I simply can't figure out how to copy an entire folder. ...

[penagate]

pbuddy_8,

Start a new thread. And in future don't try to revive 3 year old threads with different topics.

[RhinoBull]

... don't try to revive 3 year old threads ...

I didn't even realise that until now ...