Hi,
Previously i posted in this forum &
Excel Help Forum but it was marked as cross posting and closed the job without any rsolution, but please understand my need and help me, recently it was not posted in any forum.
I want to copy the list of files from excel column A (file names list) and column B (Msg Box). Below macro was copyinng only anyone format like pdf, docx or rtf, even i declare sFileType = ".pdf" sFileType = ".docx" sFileType = ".rtf" but it was not working, can anyonce please help me in reviewing the below code.
Additionally Add:
Can you please add if any file already exists in destination folder it should ask for confirmation as "Overwrite" or "Keep the both files" ...
Range is "Column A" and Msg box is "Column B"
Format types .doc, .rtf,.docx , .pdf ,html
Column "A" Heading as "File Name" & Column "B" Heading as "Staus".
If a file copied successfully msg as "Process Executed"
If a file is not available in source path msg as "Does Not Exists"
Same file name is having diferent versions like 123.doc , 123.docx , 123.pdf , 123.Html but it was copying only one format.
Please find the below code and review and please insert the above additional notes..
Code:
Sub CopyFiles1() '' Code
Dim iRow As Integer ' ROW COUNTER.
Dim SourcePath As String
Dim DestinationPath As String
Dim sFileType As String
Dim bContinue As Boolean
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 = ".pdf"
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.
If Len(Dir(SourcePath & Range("A" & CStr(iRow)).Value & sFileType)) = 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, Destination:=DestinationPath
' METHOD 2) - USING "MoveFile" METHOD TO PERMANENTLY MOVE THE FILES.
'objFSO.MoveFile Source:=sSourcePath & Range("B" & CStr(iRow)).Value & _
sFileType, Destination:=sDestinationPath
'*****
End If
End If
End If
iRow = iRow + 1 ' INCREMENT ROW COUNTER.
Wend
Set objFSO = Nothing
End Sub