• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

BROWSE, SEARCH AND COPY FILES FROM ONE LOCATION TO ANOTHER BASED ON THE LIST GIVEN IN EXCEL SHEET USING VBA.

nmkhan3010

New Member
Hi,

I need a macro for BROWSE, SEARCH AND COPY FILES FROM ONE LOCATION TO ANOTHER BASED ON THE LIST GIVEN IN EXCEL SHEET USING VBA.

Range:
File name value range is from A2 to A50
Status range is from B2 to B50

Source path: "Shold be given manually" (Files need to copy from this location based on the excel value)
Destination path: "Shold be given manually" (Matched files based on the excel value need to copied in to this location)

Msg "Files Copied "

Besides list name colum can we insert update column as "copied" if it is found and "Doesn’t Exists" if it is not found.

File name value range is from A2 to A50
Status range is from B2 to B50

Format types: .doc, .rtf , .docx , .xlsx , .pdf

Please any one help me .....

Please find a attachment...

Thanks in advance.............
 

Attachments

  • TEST.JPG
    TEST.JPG
    41.9 KB · Views: 8
nmkhan3010
You should reread Forum Rules:
You seems to missed many sentences.
 
nmkhan3010
You should reread Forum Rules:
You seems to missed many sentences.

Hi,

I hope everything is fine, if i missed anything can you please elaborate or else need more information on this .....
 
nmkhan3010
Seems You skipped to reread Forum Rules.
Here few:
  • For the best/fastest results, Upload a Sample File using the "Upload a File" button at the bottom of the page.
  • PLEASE DON'T SHOUT! We have big ears and will hear you just the same.
  • Remember people are volunteering their time to help you. Always show them the courtesy they deserve by checking and responding to answers.
 
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..

#######

>>> use code - tags <<<
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
###########
 
Last edited by a moderator:
Back
Top