複数の選択肢をVBAから使用するUserform複数選択リストボックスをパスに入れます

Question

Webサイトから見つけたコードを操作して、選択したフォルダから別のリストボックスの別のフォルダにファイルを転送するVBAユーザーフォームを作成しました。リストボックスに表示されるフォルダは毎日変更されます。 fmSingleSelectの両方のリストボックスで正常に動作しますが、2番目のリストボックスでfmMultiSelectプロパティを正しく実行する方法がわかりません（2番目のリストボックスで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

です次のコードは、あるディレクトリから複数のディレクトリへのファイルのコピーを処理するように、コードに対する "最小限の変更"の変更ですectories：

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 

私がしたすべては、それがToPathの影響を受けているコードの一部に巻き付けたように、ListBox2で選択した項目をループ再あなたのコメントアウトコードを移動しました。 （注：MsgBoxはループ内にありますが、ループ外に移動することもできますが、必要に応じてファイルを移動させるなど、より一般的なメッセージにすることができます）

私はまた、あなたのコメントコード内のいくつかのミスを修正：

• ListBox2.Items.CountはListBox2.Selected(i)
• ListBox2.Items(i).ValueでなければなりませんListBox2.ListCount
• ListBox2.Items(i).Selectedがあるべきである必要がありListBox2.List(i)