COPY FILES MACRO

nmkhan3010 · Apr 10th 2020

Hi,

i want to copy the list of files from A column and below macro was copied but it was not looping to copied command, can any one help me....

Code

Option Explicit


Sub CopyFiles()
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 = ".docx" 'TRY WITH OTHER FILE TYPES LIKE ".pdf".
sFileType = ".rtf"


' LOOP THROUGH COLUMN "B" 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("B" & 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("B" & 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
End Sub

Display More

Range is "Column A" and Msg box is "Column B" Format types .doc, .rtf,.docx , .pdf

Please anyone help me in this regards or if possible make it as easier to loop and thanks in advance.

Code

Range is "Column A" and Msg box is "Column B"  Format types .doc, .rtf,.docx , .pdf

Please anyone help me in this regards or if possible make it as easier to loop and thanks in advance.


<img src="https://www.ozgrid.com/forum/core/images/smilies/emojione/263a.png" alt=":)" class="smiley" srcset="https://www.ozgrid.com/forum/core/images/smilies/emojione/[email protected] 2x" height="23" data-tooltip="smile" id="wscSmiley_0_0">

**royUK** · Apr 10th 2020

What exactly is not happening?

nmkhan3010 · Apr 10th 2020

Macro was running properly but not copying the files listed in A column but not giving any error message i think it was not looping here ....

Can you please help me.......

objFSO.CopyFile Source:=SourcePath & Range("B" & CStr(iRow)).Value & _
sFileType, Destination:=DestinationPath

dpsychias · Apr 10th 2020

If i got your code for good and i thing everything is ok except some chanages i hv made.

Take a look and if you want something else plz let me know.

Regards

nmkhan3010 · Apr 10th 2020

Hi,

Thanks for replying but i tried on the code still it is not copying the files from source to destination based on the excel value.

Comment should be provided whether it has copied or not in column B

Am sharing screenshot as "Not working" and "Required outout (actual output)"

PFA

Can you pleas review once and am very thankful to you......

dpsychias · Apr 10th 2020

Xm.. Οκ

Plz send me the whole Function Code and your References Settings (its under Tools Tab) as my pic .

Is it possible ?

end

nmkhan3010 · Apr 10th 2020

Hi,

Please check once....

Code

Option Explicit

Sub CopyFiles()
    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 = ".docx" 'TRY WITH OTHER FILE TYPES LIKE ".pdf".
    sFileType = ".rtf"
   
    ' LOOP THROUGH COLUMN "B" 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("B" & 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("B" & 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
End Sub

Display More

Please see the above ....

Settings are the same...

dpsychias · Apr 10th 2020

Check the Attachment

The are two Functions

Sub CopyFiles() This is mine

Sub CopyFiles1() This is Yours BUT I replaced the B: with A: in

Code

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


Plz at the End of your Code  (After the Wend ) and the command :
Set objFSO = Nothing

Hope be Ok Now

Regards

nmkhan3010 · Apr 10th 2020

Hi

Am very very thankful to your hard and code was still not copying the files if it exits in my machine...

I tried a lot but still not working both code and macro was running successfully with out throwing any errors but output folder was always empty ...

Thank you so much....

If you have time you can review or else skip this, it might be my excel problem and am very thankful to for your propmt response .....

Once again Thank You................

dpsychias · Apr 10th 2020

We will fixit !

Dont worry

tomorrow morning

**royUK** · Apr 11th 2020

I've looked at your code and it seems like you need a list of files in the sheet.

Relying on InputBoxes for the file paths is open to input error though. Not fully tested but let me know if it's better.

Code

Option Explicit
Sub CopyFiles()
Dim iRow As Integer         ' ROW COUNTER.
Dim SourcePath As Object, DestinationPath As Object, objFolder As Object, objFile As Object
Dim sFileType As String
Dim bContinue As Boolean
Dim objFSO


bContinue = True
iRow = 2


Set objFSO = CreateObject("Scripting.FileSystemObject")
' THE SOURCE AND DESTINATION FOLDER WITH PATH.
Set SourcePath = objFSO.GetFolder("C:\Users\Roy Cox")
Set DestinationPath = objFSO.GetFolder("C:\")
sFileType = ".docx"    'TRY WITH OTHER FILE TYPES LIKE ".pdf".
sFileType = ".rtf"
' LOOP THROUGH COLUMN "B" 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("B" & 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


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("B" & 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
End Sub

Display More

nmkhan3010 · Apr 11th 2020

Hi,

Thanks for replying and still it is not copying the filed from source to destination even if it is avialable in that folder and commenting as "Does not exists"

Please check the attachment and thank you so much for reviewing once

**royUK** · Apr 11th 2020

You keep putting images up when an example file would be more help.

nmkhan3010 · Apr 11th 2020

Hi,

Thank you for replying ....

Sorry for inconvenience caused to you, now am attaching the same files in the ZIP folder.

Please review once and code was running successfully but copying the files into the folder and showing message as "Does not exits" even if it having a same file in the folder.

Thanks in advance for your consideration.................

dpsychias · Apr 11th 2020

Hello

Yes !! you need the full path

Is it Ok now ?

**royUK** · Apr 11th 2020

This post is so hard to follow, I have no idea who replies are for.

COPY FILES MACRO

Participate now!

Share

Tags