View Single Post
 
Old 02-02-2022, 03:23 PM
rollis13's Avatar
rollis13 rollis13 is offline Windows 10 Office 2016
Competent Performer
 
Join Date: Jan 2021
Location: Cordenons
Posts: 143
rollis13 will become famous soon enough
Default

Have try with these few changes; at least it should get you to the next step since it never asked me "File Already exists, do you want replace (Yes or No)", maybe it's yet to be implemented:
Code:
Option Explicit

Sub CopyFiles1()                                  ''Code

    Dim iRow   As Integer                         ' ROW COUNTER.
    Dim SourcePath As String
    Dim DestinationPath As String
    Dim sFileType   As Variant                    '<- changed
    Dim bContinue As Boolean
    Dim x      As Long                            '<- added

    bContinue = True
    iRow = 2
    ' THE SOURCE AND DESTINATION FOLDER WITH PATH.
    SourcePath = InputBox("PLEASE ENTER PATH", "SOURCE PATH") & "\"
    DestinationPath = InputBox("PLEASE ENTER PATH", "DESTINATION PATH") & "\"
    sFileType = Array(".rtf", ".docx", ".pdf")    '<- changed
    'sFileType = ".docx"
    'sFileType = ".rtf"
    ' LOOP THROUGH COLUMN "A" TO PICK THE FILES.
    While bContinue
        If Len(Range("A" & CStr(iRow)).Value) = 0 Then ' DO NOTHING IF THE COLUMN IS BLANK.
            MsgBox "Process executed"             ' DONE.
            bContinue = False
        Else
            ' CHECK IF FILES EXISTS.
            For x = LBound(sFileType) To UBound(sFileType) '<- added
                If Len(Dir(SourcePath & Range("A" & CStr(iRow)).Value & sFileType(x))) = 0 Then
                    Range("B" & CStr(iRow)).Value = "Does Not Exists"
                    Range("B" & CStr(iRow)).Font.Bold = True
                Else
                    Range("B" & CStr(iRow)).Value = "Copied"
                    Range("B" & CStr(iRow)).Font.Bold = False
                    If Trim(DestinationPath) <> "" Then
                        Dim objFSO
                        Set objFSO = CreateObject("scripting.filesystemobject")
                        ' CHECK IF DESTINATION FOLDER EXISTS.
                        If objFSO.FolderExists(DestinationPath) = False Then
                            MsgBox DestinationPath & " Does Not Exists"
                            Exit Sub
                        End If
                        '*****
                        ' HERE I HAVE INCLUDED TWO DIFFERENT METHODS.
                        ' I HAVE COMMENTED THE SECOND METHOD. TO THE SEE THE RESULT OF THE
                        ' SECOND METHOD, UNCOMMENT IT AND COMMENT THE FIRST METHOD.
                        ' METHOD 1) - USING "CopyFile" METHOD TO COPY THE FILES.
                        objFSO.CopyFile Source:=SourcePath & Range("A" & CStr(iRow)).Value & sFileType(x), Destination:=DestinationPath '<- changed
                        ' METHOD 2) - USING "MoveFile" METHOD TO PERMANENTLY MOVE THE FILES.
                        'objFSO.MoveFile Source:=sSourcePath & Range("B" & CStr(iRow)).Value & sFileType(x) , Destination:=sDestinationPath
                        '*****
                    End If
                End If
            Next x                                '<- added
        End If
        iRow = iRow + 1                           ' INCREMENT ROW COUNTER.
    Wend
    Set objFSO = Nothing
    
End Sub
Reply With Quote