View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Bob Phillips[_6_] Bob Phillips[_6_] is offline
external usenet poster
 
Posts: 11,272
Default Excel VBA - Copy Folder problem

Hi Paul,

All things are possible!

Dim FSO As Object

Sub Folders()
Dim i As Long
Dim sFolder As String
Dim sSource As String
Dim sTarget As String

sSource = "C:\MyTest"
sTarget = "C:\NewDir"

Set FSO = CreateObject("Scripting.FileSystemObject")

On Error Resume Next
If FSO.GetFolder(sTarget) Is Nothing Then
MkDir sTarget
End If
On Error GoTo 0

CopyFiles sSource, sTarget

End Sub

'-----------------------------------------------------------------------
Sub CopyFiles(ByVal Source As String, ByVal Target As String)
'-----------------------------------------------------------------------
Dim oFldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim sTarget As String

Set oFolder = FSO.GetFolder(Source)
If InStr(4, oFolder.Path, "\") = 0 Then
sTarget = Target
Else
sTarget = Target & Mid(Source, InStr(4, oFolder.Path, "\"), 255)
End If
On Error Resume Next
If FSO.GetFolder(sTarget) Is Nothing Then
MkDir sTarget
End If
On Error GoTo 0
Set oFolder = FSO.GetFolder(Source)
Set oFiles = oFolder.Files
For Each oFile In oFiles
oFile.Copy (sTarget & "\" & oFile.Name)
Next oFile

For Each oFldr In oFolder.Subfolders
CopyFiles oFldr.Path, Target
Next

End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"PaulC " wrote in message
...
I wish to copy a folder and its sub-folders and all its files to another
location from within an Excel VBA macro. Is this possible?

Paul


---
Message posted from http://www.ExcelForum.com/