如何在路径中使用 VBA Userform Multiselect Listbox 中的多项选择

Question

我创建了一个 VBA 用户表单，通过操作我从网站上找到的代码，供同事将文件从 selected 文件夹从一个列表框传输到第二个列表框中的另一个文件夹。列表框中填充的文件夹每天都在变化。它适用于带有 fmSingleSelect 的两个列表框，但我无法弄清楚如何在第二个列表框上使用 fmMultiSelect 属性正确运行它（是的，我在第二个列表框上将属性更改为 fmMultiSelect列表框）。

如果能够同时处理多个select 项目文件夹和运行传输，将会节省时间。

下面是单个 select 的代码，并注释掉了我为 multiselect

使用的一些代码

代码下方还有一张图片

谢谢

Private Sub CmdBtn_transfer_Click()

    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String
    Dim Value As String
    Dim i As Integer

    FromPath = "C:\Users\us-lcn-dataprep03\Desktop\Production files\" & (Me.ListBox1) '<< Change
    ToPath = "\bego.hb\MED_PRODUCTION\USA_Datapreparation\" & (Me.ListBox2)   '<< Change

' For i = 0 To ListBox2.Items.Count - 1
   ' If ListBox2.Items(i).Selected = True Then
       ' Val = ListBox2.Items(i).Value
   ' End If
'Next i

    FileExt = "*.sli*"  '<< Change

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    If FSO.FolderExists(ToPath) = False Then
        MsgBox ToPath & " doesn't exist"
        Exit Sub
    End If

    FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
    MsgBox "You can find the files from " & FromPath & " in " & ToPath
End Sub

Userform list boxes

Answer 1

以下代码是对您的代码的 "minimal change" 改动，因此它应该处理将文件从一个目录复制到多个目录：

Private Sub CmdBtn_transfer_Click()

    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String
    Dim Value As String
    Dim i As Integer

    FromPath = "C:\Users\us-lcn-dataprep03\Desktop\Production files\" & (Me.ListBox1) '<< Change

    FileExt = "*.sli*"  '<< Change

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    For i = 0 To ListBox2.ListCount - 1
        If ListBox2.Selected(i) Then
            ToPath = "\bego.hb\MED_PRODUCTION\USA_Datapreparation\" & (Me.ListBox2.List(i))    '<< Change

            If Right(ToPath, 1) <> "\" Then
                ToPath = ToPath & "\"
            End If

            If FSO.FolderExists(ToPath) = False Then
                MsgBox ToPath & " doesn't exist"
                Exit Sub
            End If

            FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
            MsgBox "You can find the files from " & FromPath & " in " & ToPath
        End If
    Next i

End Sub

我所做的只是移动您注释掉的代码，重新循环遍历 ListBox2 中的选定项目，以便它环绕受 ToPath 影响的代码部分。（注意：MsgBox 在循环内 - 您可能希望将它移到循环外，但如果这样做，您可能希望使消息更通用 - 例如 "Your files have been moved as requested"。）

我还更正了您评论代码中的一些错误：

ListBox2.Items.Count 应该是 ListBox2.ListCount
ListBox2.Items(i).Selected 应该是 ListBox2.Selected(i)
ListBox2.Items(i).Value 应该是 ListBox2.List(i)

如何在路径中使用 VBA Userform Multiselect Listbox 中的多项选择

How to use multiple selections from VBA Userform Multiselect Listbox in path

excel

vba

listbox

multi-select

userform