Copying a Folder

[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