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

[dougmarkham]

Hi Folks,

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

For example:

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Item Code (A1)[/TD]
[TD]File path (B1)[/TD]
[/TR]
[TR]
[TD]AQU10000753.pdf[/TD]
[TD]S:\APS_Logistics\Images\PetsAtHome\03) EXTERNAL CODE IMAGES\HIGH RES - CONTAIN PRODUCTION MARKS!\NOT UPLOADED\[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]








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:

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.

 

[Mentor82]

Hi Folks,

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

For example:

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Item Code (A1)[/TD]
[TD]File path (B1)[/TD]
[/TR]
[TR]
[TD]AQU10000753.pdf[/TD]
[TD]S:\APS_Logistics\Images\PetsAtHome\03) EXTERNAL CODE IMAGES\HIGH RES - CONTAIN PRODUCTION MARKS!\NOT UPLOADED\[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]








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:

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.

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

      fso. MoveFile(strSourceFilePath, strDestinationPath)

 

[Mentor82]

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

 

[Adiba Qudoos]

if you have found any code, please do share
will be grateful

 

[daverunt]

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.

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

 

[godzilla185]

I have a slight variation on the above query, with runtime error "52".

1. I have working code that imports into Column C excel file names, and makes destination folders as and where I want them.
2. Then in Column "T" the FROM folder destination is predicted based on the name of the file so that it can move to the newly created "TO" folder destinations. The reason for the references is that each download is a unique name so I cannot specify one name. I could alternative use an "approximate" name but I am unsure of how to do that.
3. The Loop then moves each file from column T to V until all the files are moved.

Example:
Column C: imports names of excel example. "todaydate&Time.csv"

Column T FROM: captures the file's location

‪C:\Users\name\Downloads\todaydate&Time.csv

Column V TO: captures new destination

‪C:\Users\name\Downloads\2022\2022-09\todaydate&Time.csv

II am not familiar with this part of the code, but I am sure the reason it is not working is due to some missing variables or declarations.

Not sure if you can help fix the below:

"Sub Move_Files()
row_number = 3

Do
row_number = row_number + 1

Name ThisWorkbook.Worksheets("TrackingFiles").Range("T" & row_number).Value As ThisWorkbook.Worksheets("TrackingFiles").Range("V" & row_number).Value

LastRow = Cells(Rows.Count, "c").End(xlUp).Row
Loop Until row_number = LastRow

End Sub"