manuel5
Oct 11, 2008, updated at Oct 12, 2008 (UTC)
view13758
view8
0
Goto Top

VBA - Ausgewählte Zeilen in Listbox alle kopieren

GermansolvedQuestionVB for ApplicationsDevelopment
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 face-sad

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
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 99047

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

Printed on: April 23, 2024 at 23:04 o'clock

8 Comments
Latest comment
Goto Top
Member: bastla
bastla Oct 11, 2008 at 20:39:41 (UTC)
Goto Top
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
Member: manuel5
manuel5 Oct 12, 2008 at 08:52:34 (UTC)
Goto Top
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
Member: bastla
bastla Oct 12, 2008 at 09:06:49 (UTC)
Goto Top
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
Member: manuel5
manuel5 Oct 12, 2008 at 09:21:17 (UTC)
Goto Top
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 face-sad . 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
Member: bastla
bastla Oct 12, 2008 at 10:11:47 (UTC)
Goto Top
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
Member: manuel5
manuel5 Oct 12, 2008 at 17:31:52 (UTC)
Goto Top
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
Member: bastla
bastla Oct 12, 2008 at 17:52:47 (UTC)
Goto Top
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
Member: manuel5
manuel5 Oct 12, 2008 at 18:13:34 (UTC)
Goto Top
Oh mein Gott - natürlich! Mannmannmann!

Danke dir, abundzu steht ich echt aufn Schlauch face-smile

Super danke dir !

Gruß Manuel
GermansolvedQuestionVB for ApplicationsDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 CommentsjstrickerWireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 CommentsAlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 Comments