VBA Code Copy Files from One folder to Another

[mielkew]

2.5.0.0
Hello guys,

I have a VBA code which is working like CUT and PASTE, I was hoping to change it form CUT and PASTE to COPY and PASTE..

any help is very much appreciated

Option Explicit


Sub MoveFiles()
   Dim i As Long
   Dim numRows As Long
   Dim oldFileName As String
   Dim newFileName As String
   
   With Sheets("Sheet1")
      'get number of rows to loop through
      numRows = .Range("D" & .Rows.Count).End(xlUp).Row
      
      For i = 4 To numRows
         '====================
         'old file
         '====================
         'build the path, test for end backslash in path for OLD filename
         oldFileName = .Range("D" & i).Value
         If Right(oldFileName, 1) <> "\" Then oldFileName = oldFileName & "\"
         
         'add the file name
         oldFileName = oldFileName & .Range("C" & i).Value
         
         'does the file exist?
         If Not FileFolderExists(oldFileName) Then
            'highlight cell when OLD file doesn't exist, and skip to next row
            .Range("D" & i).Font.Color = vbRed
            GoTo NextLoopIndex
         End If


         '==============
         'new file
         '============
         'test for end backslash in path for NEW filename
         newFileName = .Range("E" & i).Value
         If Right(newFileName, 1) <> "\" Then newFileName = oldFileName & "\"
         CreateFullPath newFileName
         'add on the filename
         newFileName = newFileName & .Range("C" & i).Value
         
         '==================
         'move file
         '===============
         Name oldFileName As newFileName
         
NextLoopIndex:
         oldFileName = ""
         newFileName = ""
      Next i
   End With
End Sub




Private Sub CreateFullPath(ByVal FilePath As String)
   Dim Folders  As Variant
   Dim tmp As String
   Dim i As Long
   
   'does the folder exist?
   If Not FileFolderExists(FilePath) Then
      If MsgBox("File path does not exist. Do you want to create it?", _
                Buttons:=vbYesNo + vbQuestion) = vbYes Then


         'build the folders
         Folders = Split(FilePath, "\")
         For i = LBound(Folders) To UBound(Folders) - 1
            tmp = tmp & Folders(i) & "\"
            If Not FileFolderExists(tmp) Then MkDir tmp
         Next i
      Else
         Exit Sub
      End If
   End If
End Sub




Private Function FileFolderExists(ByVal FilePath As String) As Boolean
   If Not Dir(FilePath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function

2.5.0.0

 

[dmt32]

Hi,

try changing this line

Name oldFileName As newFileName

to this

FileCopy oldFileName, newFileName

and see if this does what you want

Dave

 

[mielkew]

Hi,

try changing this line

Name oldFileName As newFileName

to this

FileCopy oldFileName, newFileName

and see if this does what you want

Dave

Thanks work like a charm... #dmt32 2.5.0.0