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

Question

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

能够多选项目文件夹并同时运行传输将节省时间。

下面是单选的代码，并注释掉了我为多选使用的一些代码

代码下方还有一张图片

谢谢

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

以下代码是对代码的“最小更改”更改，因此它应该处理将文件从一个目录复制到多个目录：

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 在循环内 - 您可能希望将其移到循环外，但如果这样做，您可能希望使消息更通用 - 例如“您的文件已按要求移动”。）

我还纠正了您注释代码中的一些错误：

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