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)

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

1 个答案: