Move files by list in array

[YasserKhalil]

Hello everyone
I am trying to move files by the file names in a list and this is the code but didn't work for me and i don't know the reason for not working

Code: Select all

Sub Move_Files()
    Dim a           As Variant
    Dim s           As String
    Dim t           As String
    Dim f           As String
    Dim i           As Long
    
    s = ThisWorkbook.Path & "\Source\"
    t = ThisWorkbook.Path & "\Target\"
    a = Range("A2:B" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    On Error Resume Next
        For i = 1 To UBound(a, 1)
            If a(i, 2) <> "" Then
                f = a(i, 1) & ".jpg"
                
        'If Len(Dir(s & f)) Then
            FileCopy s & f, t & f
            Kill s & f
        'End If
                
'                'If Len(f) * Len(Dir(d & f)) Then
'                    FileCopy s & f, t & f
'                    Kill s & f
'                'End If
            End If
            
            
        Next i
    On Error GoTo 0
    
    MsgBox "Done...", 64
End Sub

[HansV]

I don't know why it doesn't work for you. Does this version work?

Code: Select all

Sub Move_Files()
    Dim a           As Variant
    Dim s           As String
    Dim t           As String
    Dim f           As String
    Dim i           As Long

    s = ThisWorkbook.Path & "\Source\"
    t = ThisWorkbook.Path & "\Target\"
    a = Range("A2:B" & Cells(Rows.Count, 1).End(xlUp).Row).Value

    On Error Resume Next
    For i = 1 To UBound(a, 1)
        If a(i, 2) <> "" Then
            f = a(i, 1) & ".jpg"
            If Dir(s & f) <> "" Then
                Name s & f As t & f
            End If
        End If
    Next i
    On Error GoTo 0

    MsgBox "Done...", vbInformation
End Sub

[YasserKhalil]

That's weird. That doesn't work too
Will I have to attach some files ..? but the files are JPGs in Source folder and the list are there in column A without the extension .. and the extension is added by code

[YasserKhalil]

The file names are in Arabic and there are spaces in between the file names .. if this can make a difference

[HansV]

Please attach some of the files.

[YasserKhalil]

OK Mr. Hans

[HansV]

That's useless:
1) Your zip file doesn't contain any .jpg file with a name that occurs in column A.
2) Column B is empty, so all rows are skipped anyway.

[HansV]

The problem could be caused by the folder names in the code. The Visual Basic Editor doesn't really support non-Western characters in the source code. Try storing the names of the "source" and "target" subfolders in cells on the worksheet, for example in D1 and E1. Then refer to these in the code:

Code: Select all

    s = ThisWorkbook.Path & "\" & Range("D1").Value & "\"
    t = ThisWorkbook.Path & "\" & Range("E1").Value & "\"

[YasserKhalil]

As for the formula in column C should be changed to suit the path
I tried the trick of putting the paths in cells but the same problem


As for the file name "Yasser" it is working well but not for the Arabic file names .. What could I do now?
This is a sample name of the Arabic file names "خالد محيسن محمد"

[HansV]

Provide sample files with Arabic names.

[YasserKhalil]

Ok Mr. Hans
Here's a file
https://we.tl/kb3vQ0X2j1" onclick="window.open(this.href);return false;

I tried using Filesystemobject and MoveFile method but the same problem. it works with the English file names only but not for Arabic

[HansV]

Your use of On Error Resume Next made the actual error invisible. It turns out that the ancient FileCopy and Name methods of VBA can't handle Unicode characters. We can get around this by using the more recent Scripting.FileSystemObject, and storing the subfolder names in cells:

Code: Select all

Sub Move_Files2()
    Dim a           As Variant
    Dim s           As String
    Dim t           As String
    Dim f           As String
    Dim i           As Long
    Dim fso         As Object

    Set fso = CreateObject("Scripting.FileSystemObject")
    s = ThisWorkbook.Path & "\" & Range("D1").Value & "\"
    t = ThisWorkbook.Path & "\" & Range("E1").Value & "\"
    a = Range("A2:B" & Cells(Rows.Count, 1).End(xlUp).Row).Value

    For i = 1 To UBound(a, 1)
        If a(i, 2) <> "" Then
            f = a(i, 1) & ".jpg"
            fso.MoveFile s & f, t & f
        End If
    Next i
    On Error GoTo 0

    MsgBox "Done...", vbInformation
End Sub

This version works for me with Arabic file names and folder names (I copied some of the names in your worksheet).

[YasserKhalil]

Thanks a lot Mr. Hans
I got an error that File Not Found although checking f variable I found that this file is existing .. That's too weird specially it works for you

[HansV]

Your formulas/code combination has a fatal flaw: the numbers in column B do not necessarily correspond to the names in column A.
When I copied some of the names in column A, I took the first ones from the top, so the numbers did correspond to the names. But if there are gaps between the names of existing files, the code fails.

Let's cut out the formulas entirely - they are very inefficient anyway, and simply check if the file exists:

Code: Select all

Sub Move_Files2()
    Dim a           As Variant
    Dim s           As String
    Dim t           As String
    Dim f           As String
    Dim i           As Long
    Dim fso         As Object

    Set fso = CreateObject("Scripting.FileSystemObject")
    s = ThisWorkbook.Path & "\" & Range("D1").Value & "\"
    t = ThisWorkbook.Path & "\" & Range("E1").Value & "\"
    a = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value

    For i = 1 To UBound(a, 1)
        f = a(i, 1) & ".jpg"
        If fso.FileExists(s & f) Then
            fso.MoveFile s & f, t & f
        End If
    Next i
    On Error GoTo 0

    MsgBox "Done...", vbInformation
End Sub

[YasserKhalil]

The same problem .. No files moved at all (just the English file names moved)!!

[YasserKhalil]

I tried to hard-code a file name to see if it is working or not and I found that it is working well when hard-coding the file name

Code: Select all

Sub MoveFileTest()
    Dim fso As Object
    Dim SourceFileName, DestinFileName As String

    Set fso = CreateObject("Scripting.Filesystemobject")
    SourceFileName = "C:\Users\Future\Desktop\المستمسكات\خالد محيسن محمد.jpg"
    DestinFileName = "C:\Users\Future\Desktop\مستمسكات القائمة\خالد محيسن محمد.jpg"

    fso.MoveFile Source:=SourceFileName, Destination:=DestinFileName

    MsgBox (SourceFileName + " Moved to " + DestinFileName)
End Sub

[HansV]

The code works for me with Arabic names:

Source folder before running the code:

Before.png

Source folder after running the code:

After.png

Target folder after running the code:

Target.png

I can't hard-code names in the code since my Visual Basic Editor changes all Arabic characters to question marks "?", causing the code to fail.

[HansV]

In short: I can't offer any further help; perhaps you should try an Arabic language forum. I'm sure other users have run into the same problem.

[YasserKhalil]

But why the code is working for you and not for me
Please have a look at this (may be you can discover that fault)
https://we.tl/cqDk8xA1Pe" onclick="window.open(this.href);return false;

[HansV]

No idea, sorry.