Move files from folder to another folder based on listbox file names Selected

[Senthil Murugan]

Good Evening Everybody

Can anybody help me to Move files from folder to another folder based on listbox file names Selected


Private Sub CommandButton1_Click()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim sourceFolder As String
Dim destinationFolder As String
Dim selectedFile As String
Dim selectedItemIndex As Integer
sourceFolder = "F:\"
destinationFolder = "E:\"
If Not fso.FolderExists(destinationFolder) Then
fso.CreateFolder destinationFolder
End If

If ListBox1.ListIndex <> -1 Then

For selectedItemIndex = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(selectedItemIndex) Then
selectedFile = ListBox1.List(selectedItemIndex)

If fso.FileExists(sourceFolder & selectedFile) Then

fso.MoveFile sourceFolder & selectedFile, destinationFolder & selectedFile

MsgBox "File " & selectedFile & " has been moved to " & destinationFolder, vbInformation
Else
MsgBox "File not found: " & selectedFile, vbExclamation
End If
End If
Next selectedItemIndex
Else
MsgBox "No files selected", vbExclamation
End If
Set fso = Nothing
End Sub



Thanks in advance


A.Senthil Murugan

 

[John_w]

Try this code. It also removes the selected files from the listbox as they're moved.

Private Sub CommandButton1_Click()

    Dim fso As Object
    Dim sourceFolder As String
    Dim destinationFolder As String
    Dim selectedFile As String
    Dim selectedItemIndex As Long
    Dim numSelected As Long
    
    Set fso = CreateObject("Scripting.FileSystemObject")

    sourceFolder = "F:\"
    destinationFolder = "E:\"
    
    If Not fso.FolderExists(destinationFolder) Then
        fso.CreateFolder destinationFolder
    End If
    
    numSelected = 0
    selectedItemIndex = 0
    While selectedItemIndex < ListBox1.ListCount
        If ListBox1.Selected(selectedItemIndex) Then
            numSelected = numSelected + 1
            selectedFile = ListBox1.List(selectedItemIndex)
            If fso.FileExists(sourceFolder & selectedFile) Then
                fso.MoveFile sourceFolder & selectedFile, destinationFolder & selectedFile
                MsgBox "File " & selectedFile & " has been moved to " & destinationFolder, vbInformation
                ListBox1.RemoveItem selectedItemIndex
            Else
                MsgBox "File not found: " & selectedFile, vbExclamation
                ListBox1.Selected(selectedItemIndex) = False
                selectedItemIndex = selectedItemIndex + 1
            End If
        Else
            selectedItemIndex = selectedItemIndex + 1
        End If
    Wend
    
    If numSelected = 0 Then
        MsgBox "No files selected", vbExclamation
    End If
    
    Set fso = Nothing
    
End Sub

 

[Senthil Murugan]

Try this code. It also removes the selected files from the listbox as they're moved.

Private Sub CommandButton1_Click()

    Dim fso As Object
    Dim sourceFolder As String
    Dim destinationFolder As String
    Dim selectedFile As String
    Dim selectedItemIndex As Long
    Dim numSelected As Long
   
    Set fso = CreateObject("Scripting.FileSystemObject")

    sourceFolder = "F:\"
    destinationFolder = "E:\"
   
    If Not fso.FolderExists(destinationFolder) Then
        fso.CreateFolder destinationFolder
    End If
   
    numSelected = 0
    selectedItemIndex = 0
    While selectedItemIndex < ListBox1.ListCount
        If ListBox1.Selected(selectedItemIndex) Then
            numSelected = numSelected + 1
            selectedFile = ListBox1.List(selectedItemIndex)
            If fso.FileExists(sourceFolder & selectedFile) Then
                fso.MoveFile sourceFolder & selectedFile, destinationFolder & selectedFile
                MsgBox "File " & selectedFile & " has been moved to " & destinationFolder, vbInformation
                ListBox1.RemoveItem selectedItemIndex
            Else
                MsgBox "File not found: " & selectedFile, vbExclamation
                ListBox1.Selected(selectedItemIndex) = False
                selectedItemIndex = selectedItemIndex + 1
            End If
        Else
            selectedItemIndex = selectedItemIndex + 1
        End If
    Wend
   
    If numSelected = 0 Then
        MsgBox "No files selected", vbExclamation
    End If
   
    Set fso = Nothing
   
End Sub

Hi Mr.John

Thank you for your reply

I am having error "58" - File already exists- in the below line ( if already file exists )

fso.MoveFile sourceFolder & selectedFile, destinationFolder & selectedFile


with regards


A.Senthil Murugan

 

[John_w]

Now checks if the destination file already exists.

Private Sub CommandButton1_Click()

    Dim fso As Object
    Dim sourceFolder As String
    Dim destinationFolder As String
    Dim selectedFile As String
    Dim itemIndex As Long
    Dim numSelected As Long
    
    Set fso = CreateObject("Scripting.FileSystemObject")

    sourceFolder = "F:\"
    destinationFolder = "E:\"
    
    If Not fso.FolderExists(destinationFolder) Then
        fso.CreateFolder destinationFolder
    End If
    
    numSelected = 0
    itemIndex = 0
    While itemIndex < ListBox1.ListCount
        If ListBox1.Selected(itemIndex) Then
            numSelected = numSelected + 1
            selectedFile = ListBox1.List(itemIndex)
            If fso.FileExists(sourceFolder & selectedFile) Then
                If Not fso.FileExists(destinationFolder & selectedFile) Then
                    fso.MoveFile sourceFolder & selectedFile, destinationFolder & selectedFile
                    MsgBox "File " & selectedFile & " has been moved to " & destinationFolder, vbInformation
                    ListBox1.RemoveItem itemIndex
                Else
                    MsgBox "File " & selectedFile & " already exists in " & destinationFolder, vbExclamation
                    ListBox1.Selected(itemIndex) = False
                End If
            Else
                MsgBox "File " & selectedFile & " not found in " & sourceFolder, vbExclamation
                ListBox1.Selected(itemIndex) = False
                itemIndex = itemIndex + 1
            End If
        Else
            itemIndex = itemIndex + 1
        End If
    Wend
    
    If numSelected = 0 Then
        MsgBox "No files selected", vbExclamation
    End If
    
    Set fso = Nothing
    
End Sub

 

[Senthil Murugan]

Hi Mr.John

I am getting error in the below line

ListBox1.RemoveItem itemIndex ( after moving the file )

with regards


A.Senthil Murugan

 

[Senthil Murugan]

Sorry Mr.John

I tried in sheet Listbox but it works on Userform Listbox

Thank you & Sorry again


A.Senthil Murugan

 

[John_w]

The code works for me whether the list box is on a sheet or on a userform, as long as it's named ListBox1. In both cases ListBox1 is an ActiveX list box.

 

[John_w]

I am getting error in the below line

ListBox1.RemoveItem itemIndex ( after moving the file )

What is the exact error?

During testing I sometimes get the error "Could not set the Selected property. Unspecified error." on the ListBox.Selected(itemIndex) = False line in this part of the code when the selected file isn't found in the sourceFolder:

                    MsgBox "File " & selectedFile & " not found in " & sourceFolder, vbExclamation
                    ListBox.Selected(itemIndex) = False

This seems to happen only when the first item in the list box (itemIndex = 0) is selected. I've added code to ignore the error and unselect the item outside the loop by temporarily changing the multi-select list box to a single-select list box.

Complete code:

Private Sub CommandButton1_Click()

    Dim fso As Object
    Dim sourceFolder As String
    Dim destinationFolder As String
    Dim selectedFile As String
    Dim itemIndex As Long
    Dim numSelected As Long
    Dim saveMultiSelect As fmMultiSelect
    
    Set fso = CreateObject("Scripting.FileSystemObject")

    sourceFolder = "F:\"
    destinationFolder = "E:\"
    
    If Not fso.FolderExists(destinationFolder) Then
        fso.CreateFolder destinationFolder
    End If
    
    numSelected = 0
    itemIndex = 0
    With ListBox1
        While itemIndex < .ListCount
            If .Selected(itemIndex) Then
                numSelected = numSelected + 1
                selectedFile = .List(itemIndex)
                If fso.FileExists(sourceFolder & selectedFile) Then
                    If Not fso.FileExists(destinationFolder & selectedFile) Then
                        fso.MoveFile sourceFolder & selectedFile, destinationFolder & selectedFile
                        MsgBox "File " & selectedFile & " has been moved to " & destinationFolder, vbInformation
                        .RemoveItem itemIndex
                    Else
                        MsgBox "File " & selectedFile & " already exists in " & destinationFolder, vbExclamation
                        .Selected(itemIndex) = False
                        itemIndex = itemIndex + 1
                    End If
                Else
                    MsgBox "File " & selectedFile & " not found in " & sourceFolder, vbExclamation
                    'When itemIndex = 0, sometimes get the error "Could not set the Selected property. Unspecified error."
                    On Error Resume Next
                    .Selected(itemIndex) = False
                    On Error GoTo 0
                    itemIndex = itemIndex + 1
                End If
            Else
                itemIndex = itemIndex + 1
            End If
        Wend
        'Sometimes the 1st item (itemIndex=0) is still selected and setting it to False (unselected) causes the error "Could not set the Selected property. Unspecified error."
        'One way to unselect it is to temporarily change the multi-select list to single-select
        saveMultiSelect = .MultiSelect
        .MultiSelect = fmMultiSelectSingle
        .MultiSelect = saveMultiSelect
        'Refresh list box
        .ListIndex = .ListIndex
    End With
    
    If numSelected = 0 Then
        MsgBox "No files selected", vbExclamation
    End If
    
    Set fso = Nothing
    
End Sub