VBA - Ausgewählte Zeilen in Listbox alle kopieren

Moin moin,

wie schaffe ich es das er mir aus meiner Listbox (mit Kontrollkästchen) die angehackten "Zeilen" kopiert.
Das kopieren klappt nur leider nur den letzten Eintrag der Listbox

Private Sub cmdRechnungKopieren_Click()

Dim strDirDate As String
Dim strDirPath As String
Dim strCopyVon As String
Dim strSender As String
Dim pfad As String

nDate = Format(frmTickets.DTPicker3, "yymmdd")  
strDirDate = nDate
strSender = txtKW
strCopyVon = Label54
strDirPath = txtSpeicherPfad
strCopyVonPath = Left(strCopyVon, InStrRev(strCopyVon, "\") - 1)  
strCopyVonFolder = Mid(strCopyVonPath, InStrRev(strCopyVonPath, "\") + 1)  

CreateObject("Scripting.FileSystemObject").CopyFolder strCopyVonPath, strDirPath & "\" & strCopyVonFolder  

End Sub

Ist es überhaupt möglich?

Gruß Manuel

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 99047

Url: https://administrator.de/contentid/99047

Ausgedruckt am: 20.11.2024 um 13:11 Uhr

8 Kommentare

Neuester Kommentar

Hallo manuel5!

Wenn Du eine MultiSelect-ListBox verwendest, kannst Du die gewählten Elemente so auslesen bzw gleich für jedes einzelne Element eine Kopierroutine - im Beispiel "Sub KopiereRechnungEinzel(Pfad)" - aufrufen:

For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
        KopiereRechnungEinzel ListBox1.List(i)
    End If
Next i

Grüße
bastla

Moin bastla,

so in etwa dachte ich es mir. Nur wo soll ich diese Routine eingeben?
Soll ich hierfür nen eigenen Sub anlegen? Hmmm......

Oder cmdRechnungKopieren_Click() ) ich denke hier wäre die Auslese besser aufgehoben oder?

Gruß Manuel

Hallo manuel5!

An sich gehört diese Routine dort hin, wo Du bisher schon den Eintrag aus der ListBox ausgelesen hast (diesen Code-Teil hast Du hier nicht gepostet) - allerdings müssen jetzt ja gleich alle gewählten Einträge verarbeitet werden, sodass der Zwischenschritt über das Anzeigen im "Label54" eigentlich entfallen kann und für jede gewählte Datei, wie von mir skizziert, ein Sub zur Ausführung des Kopiervorganges aufzurufen, oder das Kopieren gleich in der Schleife selbst abgewickelt werden sollte.

Grüße
bastla

Ja, klar -

Private Sub cmdRechnungSuchen_Click()
Dim sInhalt As String
Dim strDirDate As String
Dim strSender As String
Dim strVerzeichnis As String



strDirDate = DTPicker3
strSender = TextBox41
nDate = Format(DTPicker3, "yymmdd")  
strDirDate = nDate
sInhalt = txtSuchBox
Pfad = strVerzeichnis & "\" & strDirDate & "\" & strSender & "\*.*"  
Suchbegriff = txtSuchBox
ListBox2.Clear

If txtSpeicherPfad = "" Then  
MsgBox "Bitte Ordner anlegen"  
cmdOrdnerAnlegen.SetFocus
Else
If txtSuchBox = "" Then  
MsgBox "Bitte erst Suchbegriff eingeben"  
txtSuchBox.SetFocus
Else
Set objShell = CreateObject("WScript.Shell")  

CommandLine = "%comspec% /c findstr /m /s /i /c:""" & Suchbegriff & """ """ & Pfad & """ "  

Set objExecObject = objShell.Exec(CommandLine)
    If Not objExecObject.StdOut.AtEndOfStream Then
        Filelist = Split(Trim(objExecObject.StdOut.ReadAll()), vbCrLf)
        For i = 0 To UBound(Filelist) - 1
            ListBox2.AddItem Filelist(i)
            
            Label54 = Filelist(i)
        Next
        Else
        ListBox2.AddItem "Datei nicht gefunden"  
        End If
    End If
End If

End Sub

Wenn ich es bei " For i = 0 To UBound(Filelist) - 1" einfüge, dann findet er mir garnichts mehr

. Von daher denke ich hab ich irgendwo nen Denkfehler drin.

Also -Schritt 1- Files suchen - Schritt 2 - Gefunden Files in Listbox anzeigen - Dann die ausgwählten Files in Schleife und diese dann kopieren.

So sollte es laufen oder?

Gruß Manuel

Hallo manuel5!

Die Schritte 1 und 2 hattest Du ja schon, und diese sollen sich auch gar nicht ändern. Das Ergebnis - die "ListBox2" mit allen gefundenen Einträgen - bildet dann die Grundlage für den nächsten Schritt.

Da für den Schritt 3 ja zunächst einmal Voraussetzung ist, dass die gewünschten Dateien ausgewählt wurden (wofür der Benutzerin/dem Benutzer Zeit zu geben ist), muss dieser Schritt (über den Button "cmdRechnungKopieren") getrennt gestartet werden.

Grüße
bastla

Servus bastla,

sorry, ich check das ned.

Hab ja meine Suche -->

Private Sub cmdRechnungSuchen_Click()
Dim sInhalt As String
Dim strDirDate As String
Dim strSender As String
Dim strVerzeichnis As String



strDirDate = DTPicker3
strSender = TextBox41
nDate = Format(DTPicker3, "yymmdd")  
strDirDate = nDate
sInhalt = txtSuchBox
Pfad = strVerzeichnis & "\" & strDirDate & "\" & strSender & "\*.*"  
Suchbegriff = txtSuchBox
ListBox2.Clear

If txtSpeicherPfad = "" Then  
MsgBox "Bitte Ordner anlegen"  
cmdOrdnerAnlegen.SetFocus
Else
If txtSuchBox = "" Then  
MsgBox "Bitte erst Suchbegriff eingeben"  
txtSuchBox.SetFocus
Else
Set objShell = CreateObject("WScript.Shell")  

CommandLine = "%comspec% /c findstr /m /s /i /c:""" & Suchbegriff & """ """ & Pfad & """ "  

Set objExecObject = objShell.Exec(CommandLine)
    If Not objExecObject.StdOut.AtEndOfStream Then
        Filelist = Split(Trim(objExecObject.StdOut.ReadAll()), vbCrLf)
        For i = 0 To UBound(Filelist) - 1
        '    For i = 0 To Ubound(ListBox2.ListCount - 1  
    If ListBox2.Selected(i) = True Then
        KopiereRechnungEinzel ListBox2.List(i)
    End If
Next i
       ' Next  
        Else
        ListBox2.AddItem "Datei nicht gefunden"  
        End If
    End If
End If

End Sub

Und hier muss ich dann das gefundene in die Schleife packen -->

Sub KopiereRechnungEinzel(Pfad)
For i = 0 To ListBox2.ListCount - 1
    If ListBox2.Selected(i) = True Then
        KopiereRechnungEinzel ListBox2.List(i)
    End If
Next i
End Sub

So - und dann den Schleifeninhalt in mein Ziel-Pfad kopieren -->

Private Sub cmdRechnungKopieren_Click()
'Dim strDirZiel As String  
Dim strDirDate As String
Dim strDirPath As String
Dim strCopyVon As String
Dim strSender As String
Dim Pfad As String
Dim i As Long


nDate = Format(frmTickets.DTPicker3, "yymmdd")  
'strDirZiel = "Z:\test\"  
strDirDate = nDate
strSender = txtKW
strCopyVon = ListBox2.List(i)
strDirPath = txtSpeicherPfad
strCopyVonPath = Left(strCopyVon, InStrRev(strCopyVon, "\") - 1)  
strCopyVonFolder = Mid(strCopyVonPath, InStrRev(strCopyVonPath, "\") + 1)  

CreateObject("Scripting.FileSystemObject").CopyFolder strCopyVonPath, strDirPath & "\" & strCopyVonFolder  

End Sub

ABER - wo\wie übergebe ich den Inhalt der Schleife?

Kanns drehen und wenden - sorry ich komm ned drauf.

Gruß Manuel

Hallo manuel5!

Du brauchst eigentlich nur zwei Teile:

Private Sub cmdRechnungSuchen_Click()
Dim sInhalt As String
Dim strDirDate As String
Dim strSender As String
Dim strVerzeichnis As String



strDirDate = DTPicker3
strSender = TextBox41
nDate = Format(DTPicker3, "yymmdd")  
strDirDate = nDate
sInhalt = txtSuchBox
Pfad = strVerzeichnis & "\" & strDirDate & "\" & strSender & "\*.*"  
Suchbegriff = txtSuchBox
ListBox2.Clear

If txtSpeicherPfad = "" Then  
    MsgBox "Bitte Ordner anlegen"  
    cmdOrdnerAnlegen.SetFocus
Else
    If txtSuchBox = "" Then  
        MsgBox "Bitte erst Suchbegriff eingeben"  
        txtSuchBox.SetFocus
    Else
        Set objShell = CreateObject("WScript.Shell")  

        CommandLine = "%comspec% /c findstr /m /s /i /c:""" & Suchbegriff & """ """ & Pfad & """ "  

        Set objExecObject = objShell.Exec(CommandLine)
        If Not objExecObject.StdOut.AtEndOfStream Then
            Filelist = Split(Trim(objExecObject.StdOut.ReadAll()), vbCrLf)
            For i = 0 To UBound(Filelist) - 1
                ListBox2.AddItem Filelist(i) 
            Next
        Else
            ListBox2.AddItem "Datei nicht gefunden"  
        End If
		
    End If
End If

End Sub

Wenn der Button "cmdRechnungSuchen" angeklickt wurde, ist (aufgrund des obigen Sub) das Ergebnis die Liste aller gefundenen Rechnungen (oder eben "Datei nicht gefunden") in "ListBox2".

Sobald nun das Kopieren mit Klick auf "cmdRechnungKopieren" gestartet wird, soll jede gewählte Datei (zu erkennen an der "Selected()"-Eigenschaft des jeweiligen "ListBox2"-Eintrages) kopiert werden. Das Kopieren kann in ein eigenes Sub ausgelagert, oder, wie unten gezeigt, gleich in die Ausleseschleife integriert werden:

Private Sub cmdRechnungKopieren_Click()
'Dim strDirZiel As String  
Dim strDirDate As String
Dim strDirPath As String
Dim strCopyVon As String
Dim strSender As String
Dim Pfad As String
Dim i As Long



nDate = Format(frmTickets.DTPicker3, "yymmdd")  
'strDirZiel = "Z:\test\"  
strDirDate = nDate
strSender = txtKW
strDirPath = txtSpeicherPfad

For i = 0 To ListBox2.ListCount - 1
    If ListBox2.Selected(i) = True Then
        strCopyVon = ListBox2.List(i)
        strCopyVonPath = Left(strCopyVon, InStrRev(strCopyVon, "\") - 1)  
        strCopyVonFolder = Mid(strCopyVonPath, InStrRev(strCopyVonPath, "\") + 1)  

        CreateObject("Scripting.FileSystemObject").CopyFolder strCopyVonPath, strDirPath & "\" & strCopyVonFolder  

	End If
Next i

End Sub

Dabei gelten dann für alle Dateien die selben Werte für "strDirDate", "strSender" und "strDirPath".

Grüße
bastla