SurVie
11-09-2010, 03:59 AM
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?
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?