Copy files

[SurVie]

Hello,

I'm trying to use the code from vbaexpress.com
But i can't seem to get it to work. I'm using this code:

Option Explicit

Sub Copy_Files_To_New_Folder()

Dim objFSO As FileSystemObject, objFolder As Folder, PathExists As Boolean
Dim objFile As File, strSourceFolder As String, strDestFolder As String
Dim x, Counter As Integer, Overwrite As String
Dim sPath As String
sPath = ActiveWorkbook.Path

Application.ScreenUpdating = False
Application.EnableEvents = False

strSourceFolder = sPath
strDestFolder = "C:\test"
'''''''''' strSourceFolder = Range("A1")

On Error Resume Next
x = GetAttr(strDestFolder) And 0
If Err = 0 Then
PathExists = True
Overwrite = MsgBox("The folder may contain duplicate files," & vbNewLine & _
"Do you wish to overwrite existing files with same name?", vbYesNo, "Alert!")
If Overwrite <> vbYes Then Exit Sub
Else:
PathExists = False
If PathExists = False Then MkDir (strDestFolder)
End If

Set objFSO = New FileSystemObject
Set objFolder = objFSO.GetFolder(strSourceFolder)
Counter = 0

If Not objFolder.Files.Count > 0 Then GoTo NoFiles

For Each objFile In objFolder.Files

objFile.Copy strDestFolder & "\" & objFile.Name 'use the destination path string, add a / separator and the file name

Counter = Counter + 1 'increment a count of files copied

Next objFile 'go to the next file

MsgBox "All " & Counter & " Files from " & vbCrLf & vbCrLf & strSourceFolder & vbNewLine & vbNewLine & _
" copied/moved to: " & vbCrLf & vbCrLf & strDestFolder, , "Completed Transfer/Copy!"
'Message to user confirming completion

Set objFile = Nothing: Set objFSO = Nothing: Set objFolder = Nothing 'clear the objects

Exit Sub

But when i try and run this is says there are no files in the folder, but there are. I'm running it in excel 2007.

Can anyone help me to figure out what i'm doing wrong here?

[GTO]

Greetings SurVie,

Welcome to vbaexpress:)

I'm not sure what happened, but your code snippet seems cut-off, as I see an Exit Sub, but no End Sub.

Can you post a link to the thread or KB entry that you got the code from?

Thanks,

Mark

[SurVie]

Sure,

I can't yet post links though. The link is from vbaexpress.com and then kb/getarticle.php?kb_id=827

Thanks in advance

[GTO]

...But when i try and run this is says there are no files in the folder, but there are. I'm running it in excel 2007.

Can anyone help me to figure out what i'm doing wrong here?

I just stepped through XLGibbs code, and it worked fine for me, including creating the destination folder. What type of files are in your source folder?

Mark

[Kenneth Hobs]

That method will error if your workbook is in the source folder. I have used some methods to avoid that problem.

Trying to duplicate your msgbox, I could not. Be sure to check your string for the source folder carefully. This macro is a short version to get your file number count to help with troubleshooting. Add the reference commented from the VBE's Tools menu Reference.


Sub Test_CountFilesInFolder()
Dim aPath As String
aPath = ThisWorkbook.Path
MsgBox "Number of files in " & aPath & ": " & _
CountFilesInFolder(aPath)
End Sub

'=CountFilesInFolder("c:\")
Function CountFilesInFolder(pFolder As String) As Long
Rem Needs Reference: MicroSoft Scripting Runtime, scrrun.dll
Rem Instructions: http://support.microsoft.com/default.aspx?scid=kb;en-us;186118
Dim FSO As New FileSystemObject
Dim i As Long

With FSO
'Exit if parent folder does not exist.
If Not .FolderExists(pFolder) Then
MsgBox pFolder & " does not exist.", vbCritical, "Macro Ending"
Exit Function
End If

i = .GetFolder(pFolder).Files.Count
End With
Set FSO = Nothing
CountFilesInFolder = i
End Function

[SurVie]

That method will error if your workbook is in the source folder. I have used some methods to avoid that problem.

Trying to duplicate your msgbox, I could not. Be sure to check your string for the source folder carefully. This macro is a short version to get your file number count to help with troubleshooting. Add the reference commented from the VBE's Tools menu Reference.


Sub Test_CountFilesInFolder()
Dim aPath As String
aPath = ThisWorkbook.Path
MsgBox "Number of files in " & aPath & ": " & _
CountFilesInFolder(aPath)
End Sub

'=CountFilesInFolder("c:\")
Function CountFilesInFolder(pFolder As String) As Long
Rem Needs Reference: MicroSoft Scripting Runtime, scrrun.dll
Rem Instructions:
Dim FSO As New FileSystemObject
Dim i As Long

With FSO
'Exit if parent folder does not exist.
If Not .FolderExists(pFolder) Then
MsgBox pFolder & " does not exist.", vbCritical, "Macro Ending"
Exit Function
End If

i = .GetFolder(pFolder).Files.Count
End With
Set FSO = Nothing
CountFilesInFolder = i
End Function

I tried your code and it counted 6 files, which is correct. I'll keep trying to get the code right...

As far as the files that i want to copy, they are all excel files (2003 and 2007).

Anyway thanks for the help so far. I guess i'll just have to keep trying to get it right :)

[Kenneth Hobs]

You might like this method:
Sub Test_CopyFolder()
CopyFolder ThisWorkbook.Path, ThisWorkbook.Path & "\t\t"
End Sub

Sub CopyFolder(sSource As String, sDest As String)
Dim rc

If Dir(sSource, vbDirectory) = Empty Then
MsgBox "Folder does not exist: " & sSource, vbCritical, "Macro Ending"
Exit Sub
End If

If Dir(sDest, vbDirectory) = Empty Then
rc = Shell("cmd /c mkdir " & sDest, vbHide)
End If
Do Until Dir(sDest, vbDirectory) <> Empty
DoEvents
Loop
rc = Shell("cmd /c copy " & sSource & " " & sDest, vbHide)

End Sub

[SurVie]

Thanks for you help, that code will work fine for me as an alternative.

[SurVie]

You might like this method:
Sub Test_CopyFolder()
CopyFolder ThisWorkbook.Path, ThisWorkbook.Path & "\t\t"
End Sub

Sub CopyFolder(sSource As String, sDest As String)
Dim rc

If Dir(sSource, vbDirectory) = Empty Then
MsgBox "Folder does not exist: " & sSource, vbCritical, "Macro Ending"
Exit Sub
End If

If Dir(sDest, vbDirectory) = Empty Then
rc = Shell("cmd /c mkdir " & sDest, vbHide)
End If
Do Until Dir(sDest, vbDirectory) <> Empty
DoEvents
Loop
rc = Shell("cmd /c copy " & sSource & " " & sDest, vbHide)

End Sub

Question, as i'm developing my model it turns out it would be great if it also could copy all the folders (in the folder) aswell as the files in folder. Is there a way the above code could be amended to fit this need?

[Kenneth Hobs]

I would use xcopy to do that. It has several command line switch options. Try doing it at a DOS prompt a few times first. To get to a DOS prompt: Start > Run > cmd > OK. Type c: and press enter key to switch to the c: drive. Type "xcopy /?" without quotes and press enter key to view help for xcopy.

Here is an example from a DOS Prompt:
xcopy "\\Matpc11\My (file://\\Matpc11\My) Files\*.*" "T:\bu\AA2" /y /e /d

Once you know how, just build that string for your Shell() command in vba. The command line switch /e is what you will want.