VBA to move files from one location to another - Run-time error '13' Type mismatch

dougmarkham

Board Regular
Joined
Jul 19, 2016
Messages
203
Office Version
365
Platform
Windows
Hi Folks,

I have developed some VBA code to move files from a source destination to a target destination.

For example:

Item Code (A1)File path (B1)
AQU10000753.pdfS:\APS_Logistics\Images\PetsAtHome\03) EXTERNAL CODE IMAGES\HIGH RES - CONTAIN PRODUCTION MARKS!\NOT UPLOADED\

<tbody>
</tbody>








The code tells me to click on the cells containing item codes (establishing the name of the target files); thereafter, it asks me to select the range of cells containing the corresponding file paths (in this case, B2).

Then, a dialogue box comes up for me to select the target folder.

The problem is, the code I have is returning a: Run-time error '13' Type mismatch at the following point in red:

Code:
Sub movefiles()
'Updateby Extendoffice
    Dim xRg As Range, xCell As Range
    Dim xSFileDlg As Range
    Dim xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xVal As String
    Worksheets("UploadImagesHighRes").Activate
    'On Error Resume Next
    Set xRg = Application.InputBox("Please select the file names:", "Excel tools", ActiveWindow.RangeSelection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xSFileDlg = Application.InputBox("Please select the file names:", "Excel tools", ActiveWindow.RangeSelection.Address, , , , , 8)
    If xSFileDlg.Show <> -1 Then Exit Sub
    xSPathStr = xSFileDlg
    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = " Please select the destination folder:"
    If xDFileDlg.Show <> -1 Then Exit Sub
    xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
    For Each xCell In xRg
        xVal = xCell.Value
        If TypeName(xVal) = "String" And xVal <> "" Then
[SIZE=4][COLOR=#b22222][B]            FileCopy xSPathStr & xVal, xDPathStr & xVal[/B][/COLOR][/SIZE]
            Kill xSPathStr & xVal
        End If
    Next
End Sub
Would anybody be able to help me to modify this code please?

Kind regards,

Doug.
 

Some videos you may like

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

Mentor82

Active Member
Joined
Dec 30, 2018
Messages
307
Hi Folks,

I have developed some VBA code to move files from a source destination to a target destination.

For example:

Item Code (A1)File path (B1)
AQU10000753.pdfS:\APS_Logistics\Images\PetsAtHome\03) EXTERNAL CODE IMAGES\HIGH RES - CONTAIN PRODUCTION MARKS!\NOT UPLOADED\

<tbody>
</tbody>








The code tells me to click on the cells containing item codes (establishing the name of the target files); thereafter, it asks me to select the range of cells containing the corresponding file paths (in this case, B2).

Then, a dialogue box comes up for me to select the target folder.

The problem is, the code I have is returning a: Run-time error '13' Type mismatch at the following point in red:

Code:
Sub movefiles()
'Updateby Extendoffice
    Dim xRg As Range, xCell As Range
    Dim xSFileDlg As Range
    Dim xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xVal As String
    Worksheets("UploadImagesHighRes").Activate
    'On Error Resume Next
    Set xRg = Application.InputBox("Please select the file names:", "Excel tools", ActiveWindow.RangeSelection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xSFileDlg = Application.InputBox("Please select the file names:", "Excel tools", ActiveWindow.RangeSelection.Address, , , , , 8)
    If xSFileDlg.Show <> -1 Then Exit Sub
    xSPathStr = xSFileDlg
    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = " Please select the destination folder:"
    If xDFileDlg.Show <> -1 Then Exit Sub
    xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
    For Each xCell In xRg
        xVal = xCell.Value
        If TypeName(xVal) = "String" And xVal <> "" Then
[SIZE=4][COLOR=#b22222][B]            FileCopy xSPathStr & xVal, xDPathStr & xVal[/B][/COLOR][/SIZE]
            Kill xSPathStr & xVal
        End If
    Next
End Sub
Would anybody be able to help me to modify this code please?

Kind regards,

Doug.
Hi,
For moving a file from one location to another use file system object scripting. Makr sure that both source file path and destination file path are correct-those must be full directories with file name and its extension. Here's an example of using file system object scripting.

Code:
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")

      fso. MoveFile(strSourceFilePath, strDestinationPath)
 

Mentor82

Active Member
Joined
Dec 30, 2018
Messages
307
Hi again,
When usung file system object the soirce directory should include whole path with the file name and its extension ex. C:\temp\test.xlsx wheras the destination directory shoud be a directory of a folder to which the file is meant to be moved to ex. D:\test_2

Regards,
Sebastian
 

daverunt

Well-known Member
Joined
Jul 9, 2009
Messages
1,800
Office Version
2013
Platform
Windows
Hi,

the problem appears to be the selection of multiple paths for xSPathStr.
As I see it this contains an array of path strings you have selected.
As a test, try to run the macro and only select multiple files in column A and a single path from column B it should work.

With xRg you separate the values of the files selection using a loop for each cell value. You don't separate the paths selection with xSPathStr

Are the paths in the same rows as the selected files? I assume so.
In this case you just use the cell offset to get the path for each file.

I have commented out the path selector and added a line in the loop to get the file path.

I have assumed Column B is the path container.

Code:
Sub movefiles()
'Updateby Extendoffice
    Dim xRg As Range, xCell As Range
    Dim xSFileDlg As Range
    Dim xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xVal As String
    Worksheets("Sheet1").Activate
    'On Error Resume Next
    Set xRg = Application.InputBox("Please select the file names:", "Excel tools", ActiveWindow.RangeSelection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    'Set xSFileDlg = Application.InputBox("Please select the paths:", "Excel tools", ActiveWindow.RangeSelection.Address, , , , , 8)
    'If xSFileDlg.Show <> -1 Then Exit Sub
    'xSPathStr = xSFileDlg
    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = " Please select the destination folder:"
    If xDFileDlg.Show <> -1 Then Exit Sub
    xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
    For Each xCell In xRg
        xVal = xCell.Value
        [COLOR="#FF0000"]xSPathStr = xCell.Offset(0, 1)[/COLOR]
        If TypeName(xVal) = "String" And xVal <> "" Then
            FileCopy xSPathStr & xVal, xDPathStr & xVal
            Kill xSPathStr & xVal
        End If
    Next
End Sub
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,099,462
Messages
5,468,791
Members
406,609
Latest member
cocobeans

This Week's Hot Topics

Top