#1
|
|||
|
|||
Copy files from one location to another
Hi,
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 Thanks in Advance... |
#2
|
||||
|
||||
__________________
Did you know you can thank someone who helped you? Click on the tiny scale in the right upper hand corner of your helper's post |
#3
|
|||
|
|||
But i didnt get any responeses from any users and it was posted on 02-24-2020, 08:26 AM. i think it was ignored so i reposted again..
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
VBA Word - Search Within Files Containing A String - Copy Files to New Folder | jc491 | Word VBA | 0 | 01-09-2016 12:00 PM |
Copy selected text to another location automatically | apo | Word VBA | 1 | 10-17-2015 02:43 AM |
Copy format, size, location | s_manoj | PowerPoint | 5 | 05-21-2014 07:06 AM |
Copy table to another location in the same document | Sektor | Word VBA | 2 | 03-31-2014 09:28 PM |
VBA to copy bookmark to a new location | kent | Word VBA | 5 | 06-14-2012 02:18 PM |