Amend existing code to move files instead of copy to new location

[rachel06]

Hello,

I'm using a macro to copy from one location to another using the below. I'm wondering how I can amend this to MOVE the files instead of copy. Or better yet, is there a way to add a message box to ask the user if they want to move or copy and have it work from there?

I'm sure it's something simple that I'm missing but any help is appreciated!

Dim NewName As String

Sub Copyfilefromto()

Dim mycheck As VbMsgBoxResult
        
    mycheck = MsgBox("Confirm that you'd like to start the file mover. The more files to move, the longer this will take.", vbYesNo)
    If mycheck = vbNo Then
        Exit Sub
        End If
   

Dim a As Long, x As Long
Dim FilePath As String
Dim FileName As String
Dim ErrCount As Long

ErrCount = 1

x = Worksheets("Query").Cells(Rows.Count, 3).End(xlUp).Row
For a = 4 To x

FilePath = Worksheets("Query").Cells(a, 4)
FileName = Worksheets("Query").Cells(a, 3)

On Error GoTo ErrorHandler

Call GetFileType(FileName, FilePath, a)

FileCopy Worksheets("Query").Cells(a, 4) & Worksheets("Query").Cells(a, 3), Worksheets("Query").Cells(a, 1) & NewName

Next a

MsgBox ("Process Complete. Please review ErrMsgs Sheet for failures.")
Cells(2, 5).Value = x - 3
Exit Sub

ErrorHandler:
    Worksheets("ErrMsgs").Activate
    Cells(ErrCount, 1).Value = FileName
    Cells(ErrCount, 2).Value = Err.Description
    Worksheets("Query").Activate
    ErrCount = ErrCount + 1
Resume Next

End Sub

 

[johnnyL]

I think it would look something like the following:

'Copy a file
FileCopy Worksheets("Query").Cells(a, 4) & Worksheets("Query").Cells(a, 3), Worksheets("Query").Cells(a, 1) & NewName


'Move a file
  Name Worksheets("Query").Cells(a, 4) & Worksheets("Query").Cells(a, 3) As Worksheets("Query").Cells(a, 1) & NewName

I could be wrong though.

 

[rachel06]

Hi Johnny,

Thank you for the response! This still copied the file from one location to the next. Any other ideas? Or if that option DID work, is there a way to have a message box to select either COPY or MOVE?

 

[tonyyy]

Rachel,

You might consider the following...

Dim NewName As String

Sub Copyfilefromto()

Dim mycheck As VbMsgBoxResult
Dim a As Long, x As Long
Dim FilePath As String
Dim FileName As String
Dim ErrCount As Long
       
'mycheck = MsgBox("Confirm that you'd like to start the file mover. The more files to move, the longer this will take.", vbYesNo)
'If mycheck = vbNo Then
'    Exit Sub
'End If

mycheck = MsgBox("Click Yes to copy files." & vbCrLf & vbCrLf & "Click No to move files.", _
    Buttons:=vbYesNoCancel, Title:="Do you want want to copy or move files?")
    If mycheck = vbCancel Then Exit Sub
   
ErrCount = 1

x = Worksheets("Query").Cells(Rows.Count, 3).End(xlUp).Row
For a = 4 To x
    FilePath = Worksheets("Query").Cells(a, 4)
    FileName = Worksheets("Query").Cells(a, 3)
    On Error GoTo ErrorHandler
    Call GetFileType(FileName, FilePath, a)
    If mycheck = vbYes Then
        ''''copy
        FileCopy Worksheets("Query").Cells(a, 4) & Worksheets("Query").Cells(a, 3), Worksheets("Query").Cells(a, 1) & NewName
    Else
        ''''move
        Name Worksheets("Query").Cells(a, 4) & Worksheets("Query").Cells(a, 3) As _
            Worksheets("Query").Cells(a, 1) & Worksheets("Query").Cells(a, 3)
    End If
Next a

MsgBox ("Process Complete. Please review ErrMsgs Sheet for failures.")
Cells(2, 5).Value = x - 3
Exit Sub

ErrorHandler:
    Worksheets("ErrMsgs").Activate
    Cells(ErrCount, 1).Value = FileName
    Cells(ErrCount, 2).Value = Err.Description
    Worksheets("Query").Activate
    ErrCount = ErrCount + 1
Resume Next

End Sub

Happy New Year!

Tony

 

[rachel06]

Rachel,

You might consider the following...

Dim NewName As String

Sub Copyfilefromto()

Dim mycheck As VbMsgBoxResult
Dim a As Long, x As Long
Dim FilePath As String
Dim FileName As String
Dim ErrCount As Long
      
'mycheck = MsgBox("Confirm that you'd like to start the file mover. The more files to move, the longer this will take.", vbYesNo)
'If mycheck = vbNo Then
'    Exit Sub
'End If
'Added Line to click Cancel to Exit - Rachel 12/31/21
mycheck = MsgBox("Click Yes to copy files." & vbCrLf & vbCrLf & "Click No to move files." & vbCrLf & vbCrLf & "Click Cancel to Exit.", _
    Buttons:=vbYesNoCancel, Title:="Do you want want to copy or move files?")
    If mycheck = vbCancel Then Exit Sub
  
ErrCount = 1

x = Worksheets("Query").Cells(Rows.Count, 3).End(xlUp).Row
For a = 4 To x
    FilePath = Worksheets("Query").Cells(a, 4)
    FileName = Worksheets("Query").Cells(a, 3)
    On Error GoTo ErrorHandler
    Call GetFileType(FileName, FilePath, a)
    If mycheck = vbYes Then
        ''''copy
        FileCopy Worksheets("Query").Cells(a, 4) & Worksheets("Query").Cells(a, 3), Worksheets("Query").Cells(a, 1) & NewName
    Else
        ''''move
        Name Worksheets("Query").Cells(a, 4) & Worksheets("Query").Cells(a, 3) As _
            Worksheets("Query").Cells(a, 1) & Worksheets("Query").Cells(a, 3)
    End If
Next a

MsgBox ("Process Complete. Please review ErrMsgs Sheet for failures.")
Cells(2, 5).Value = x - 3
Exit Sub

ErrorHandler:
    Worksheets("ErrMsgs").Activate
    Cells(ErrCount, 1).Value = FileName
    Cells(ErrCount, 2).Value = Err.Description
    Worksheets("Query").Activate
    ErrCount = ErrCount + 1
Resume Next

End Sub

Happy New Year!

Tony

Hi Tony,

Thanks for the response! I thought this was working as I had the folder open to see if the file moved. It disappeared for a second like it had moved then came back. It looks like that's still copying the file. Any other suggestions?

Also, instead of like Yes for Copy and No for Move, can those Buttons actually say Copy or Move? I've found some other articles on this, but they just seem super confusing and make it seem like it might not be worthwhile. Perhaps it's because I'm off today and shouldn't actually be working, but I'm so determined to get this one figured out

Finally, I tried editing the title of the msgbox, but what I added was too long. I'm trying to force the text onto two lines in the msg box, but nothing is working. I've tried & Chr(10) &, & vbCrLf &, and & vbNewLine & to force it onto two lines. Perhaps those don't work for titles?

Thank you and Happy New Year!

 

[tonyyy]

So the FileCopy and Name (ie, move) statements work fine in my test folders. I'm assuming that Columns 4 and 3 contain the file paths and file names, respectively. Can you please check to see that the paths and names are all valid? And that the file paths all end with a backslash (\).

If they are all correct, perhaps you can share the code in the GetFileType routine. Is there something there preventing the file move to complete correctly?

As for changing the Button labels, that's beyond my vba knowledge. You could create a Userform with customized buttons.

Finally, regarding the length of the Title of the MsgBox, could you put the text into the Prompt? And use vbcrlf to add new lines or blank lines to control line spacing.

 

[rachel06]

Hi Tony,


I confirmed the paths and names are valid and thee was a backslash. I've had that issue before where if it's missing, it goes one folder short of where it's supposed to go and that is not fun.

In my spreadsheet column A is the destination location, column B is a "find" formula that finds a client # in column C which is the file name. Column D is the source path.

Here is the "GetFileType" information:

Sub GetFileType(SourceName, SourcePath, iRow)
    mySourcePath = SourcePath & SourceName
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFile(mySourcePath)
        
    Select Case mySource.Type
        Case "Adobe Acrobat Document"
            Base = Left(Cells(iRow, 3), InStr(Cells(iRow, 3), ".pdf") - 1)
            Call BuildName(Base, ".pdf")
        Case "Microsoft Excel Worksheet"
            Base = Left(Cells(iRow, 3), InStr(Cells(iRow, 3), ".xlsx") - 1)
            Call BuildName(Base, ".xlsx")
        Case "Microsoft Word Document"
            Base = Left(Cells(iRow, 3), InStr(Cells(iRow, 3), ".pdf") - 1)
            Call BuildName(Base, ".doc")
        Case "Outlook Item"
            Base = Left(Cells(iRow, 3), InStr(Cells(iRow, 3), ".pdf") - 1)
            Call BuildName(Base, ".msg")
    End Select
    Cells(iRow, 6).Value = NewName
End Sub

Thank you so much!!

 

[tonyyy]

A couple more question please...

When you move a file, do you want it re-named as NewName? Or retain the existing name?

Is the ErrorHandler capturing any errors?

 

[rachel06]

Hi Tony,

In this case, they would retain the same name. There is only a NewName if there is data in one of two cells. The ErrorHandler is only showing errors if the file path/ name is too long for the destination location.

Appreciate your help!