Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1612to1616
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Verknüpfung Dateipfad

Verknüpfung Dateipfad
21.03.2018 13:13:45
Rene
Hallo zusammen,
erst einmal Danke an Uwe für den Code zum Datenpaket erstellen.
Sub Dateien_kopieren()
On Error GoTo Fehler
Dim TB, L1 As Integer, LR As Double, Z
Dim PfadOld As String, Datei As String
Dim PfadNew As String, Spalte As String, SP As Integer
Set TB = ActiveWorkbook.Sheets("Tabelle1")
L1 = 1 'Start ab Zeile1
PfadOld = "X:\Temp\" ' inkl. \ am Ende
PfadNew = "X:\Temp\ABC\" ' inkl. \ am Ende
If Dir(PfadNew, vbDirectory) = "" Then MkDir PfadNew ' Wenn Verzeichnis fehlt, erstellen
Spalte = InputBox("Welche Spalte soll abgearbeitet werden?", "Dateien separieren", "C")
SP = TB.Columns(Spalte).Column 'Zahl der Spalte
LR = TB.Cells(TB.Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
For Each Z In TB.Range(TB.Cells(L1, SP), TB.Cells(LR, SP)) 'Jeder Eintag wird abgearbeitet
If Z  "" Then
Datei = Dir(PfadOld & Z & "*.*")
Do While Len(Datei) > 0
Select Case Right(Datei, 4)
Case ".pdf", ".dxf", ".dwg"
FileCopy PfadOld & Datei, PfadNew & Datei
Case Else
'nichts
End Select
Datei = Dir() ' nächste Datei
Loop
End If
Next
Err.Clear
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description: Err.Clear
End Sub

Jetzt habe ich in meiner UserForm einen Button erzeugt, der einen bestimmten Pfad sucht und auch anzeigt.(Modul)
Ich bekomme jetzt leider nicht die Verknüpfung zu dem Code der mir die Daten kopiert.
Meine Vorstellung war es den Ausdruck: "PfadNew" mit meinem Modul zu ersetzen.
Sub Zielpfad()
Dim Ordnerpfad
Dim dat
Set dat = Application.FileDialog(msoFileDialogFolderPicker)
With dat
.Title = "Zielpfad auswählen....."
.InitialFileName = "C:\Users\rene\Desktop\VBA_TEST_PROJEKT\" 'oder was auch immer
If .Show = -1 Then
For Each Ordnerpfad In .SelectedItems
MsgBox Ordnerpfad 'Zur weiteren verwendung
Next Ordnerpfad
End If
End With
End Sub

Kann mir jemand nen Tip geben wie ich aus PfadNew = Zielpfad mache.
Vielen Dank schon mal für eure Hilfe.
Gruß
René

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Verknüpfung Dateipfad
21.03.2018 14:01:28
fcs
Hallo Rene,
wenn du eine Function statt einer Sub verwendest, dann funktioniert es relativ einfach.
Gruß
Franz
Sub Dateien_kopieren()
On Error GoTo Fehler
Dim TB, L1 As Integer, LR As Double, Z
Dim PfadOld As String, Datei As String
Dim PfadNew As String, Spalte As String, SP As Integer
Set TB = ActiveWorkbook.Sheets("Tabelle1")
L1 = 1 'Start ab Zeile1
PfadOld = "X:\Temp\" ' inkl. \ am Ende
PfadNew = Zielpfad
If PfadNew = "" Then
Exit Sub
Else
PfadNew = PfadNew & "\" ' inkl. \ am Ende
End If
Spalte = InputBox("Welche Spalte soll abgearbeitet werden?", "Dateien separieren", "C")
SP = TB.Columns(Spalte).Column 'Zahl der Spalte
LR = TB.Cells(TB.Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
For Each Z In TB.Range(TB.Cells(L1, SP), TB.Cells(LR, SP)) 'Jeder Eintag wird abgearbeitet
If Z  "" Then
Datei = Dir(PfadOld & Z & "*.*")
Do While Len(Datei) > 0
Select Case Right(Datei, 4)
Case ".pdf", ".dxf", ".dwg"
FileCopy PfadOld & Datei, PfadNew & Datei
Case Else
'nichts
End Select
Datei = Dir() ' nächste Datei
Loop
End If
Next
Err.Clear
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description: Err.Clear
End Sub
Function Zielpfad() As String
Dim Ordnerpfad
Dim dat
Set dat = Application.FileDialog(msoFileDialogFolderPicker)
With dat
.Title = "Zielpfad auswählen....."
.InitialFileName = "C:\Users\rene\Desktop\VBA_TEST_PROJEKT\" 'oder was auch immer
If .Show = -1 Then
Zielpfad = .SelectedItems(1)
MsgBox Zielpfad 'Zur weiteren verwendung
End If
End With
End Function

Anzeige
AW: Verknüpfung Dateipfad
21.03.2018 14:03:26
UweD
Hallo
so auf die Schnelle, ungeprüft...
Sub Dateien_kopieren()
    On Error GoTo Fehler
    Dim TB, L1 As Integer, LR As Double, Z
    Dim PfadOld As String, Datei As String
    Dim PfadNew As String, Spalte As String, SP As Integer
    Dim dat
    Set dat = Application.FileDialog(msoFileDialogFolderPicker)

    
    Set TB = ActiveWorkbook.Sheets("Tabelle1")
    L1 = 1 'Start ab Zeile1 
    PfadOld = "X:\Temp\" ' inkl. \ am Ende 
    
    
    
    With dat
        .Title = "Zielpfad auswählen....."
        .InitialFileName = "C:\Users\rene\Desktop\VBA_TEST_PROJEKT\" 'oder was auch immer 
        If .Show = -1 Then
            PfadNew = .SelectedItems(1) & "\"
        End If
    End With
    
    
    Spalte = InputBox("Welche Spalte soll abgearbeitet werden?", "Dateien separieren", "C")
    SP = TB.Columns(Spalte).Column 'Zahl der Spalte 
    LR = TB.Cells(TB.Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte 
        
    For Each Z In TB.Range(TB.Cells(L1, SP), TB.Cells(LR, SP)) 'Jeder Eintag wird abgearbeitet 
        If Z <> "" Then
            Datei = Dir(PfadOld & Z & "*.*")
            Do While Len(Datei) > 0
            
                Select Case Right(Datei, 4)
                    Case ".pdf", ".dxf", ".dwg"
                        
                        FileCopy PfadOld & Datei, PfadNew & Datei
                        
                    Case Else
                        
                        'nichts 
                        
                End Select
                
                Datei = Dir() ' nächste Datei 
            Loop
        End If
        
    Next
    
    Err.Clear
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub


LG UweD
Anzeige
AW: Verknüpfung Dateipfad
21.03.2018 15:48:01
Rene
Hallo Uwe, Hallo Franz,
beide Codes laufen. In der UserForm möchte ich meinen Kollegen die Möglichkeit geben den Zielpfad und den Suchpfad (auch Unterordner) auszuwählen bzw. auch anzeigen zu lassen.
Jetzt sind diese beiden Funktion aber außen vor. Heißt, wenn ich den Button "Daten kopiere" drücke kommt das Auswahlfenster für den Pfad. Diesen habe ich aber schon vorher ausgewählt. Diese Auswahl muss nun im Code von "Daten kopieren" berücksichtigt werden. Daten kopieren soll auch wirklich nur das kopieren sein bzw. vorher die Spaltenauswahl (gar nicht so schlecht, so kann man noch variieren)
Userbild
Gruß
René
Anzeige
AW: Verknüpfung Dateipfad
22.03.2018 07:43:50
fcs
Hallo René,
wenn man vorhe ermittelte Daten in einem Makro verwenden, dann übergibt mn sie am besten als Parameter.
Code für Schaltfläche "Daten kopieren" im Userform:
die Namen von Button und Textboxen ggf anpassen.
Private Sub CommandButton4_Click()
If Me.TextBox1 = "" Or Me.TextBox2 = "" Then
MsgBox "Bitte Zielordner und Suchpfad auswählen!"
ElseIf Me.TextBox1 = Me.TextBox2 Then
MsgBox "Zielordner und Suchpfad müssen verschiedenn seln!"
Else
Me.Hide
Call Dateien_kopieren(PfadNew:=Me.TextBox1, PfadOld:=Me.TextBox2)
Me.Show
End If
End Sub
angepasstes Makro "Dateien_kopieren"
Sub Dateien_kopieren(PfadNew As String, PfadOld As String)
On Error GoTo Fehler
Dim TB, L1 As Integer, LR As Double, Z
Dim Datei As String, arrOrdner() As String, intK, varOrdner, intS, intE
Dim Spalte As String, SP As Integer
Set TB = ActiveWorkbook.Sheets("Tabelle1")
L1 = 1 'Start ab Zeile1
If Right(PfadOld, 1)  "\" Then PfadOld = PfadOld & "\" ' inkl. \ am Ende
If Right(PfadNew, 1)  "\" Then PfadNew = PfadNew & "\" ' inkl. \ am Ende
If Dir(PfadNew, vbDirectory) = "" Then MkDir PfadNew ' Wenn Verzeichnis fehlt, erstellen
'Unterordner des Suchpfades in Array sammeln
intK = 1
ReDim arrOrdner(1 To intK)
arrOrdner(intK) = PfadOld
intE = 0
Unterordner:
intS = intE + 1
intE = UBound(arrOrdner, 1)
For Z = intS To intE
Datei = Dir(arrOrdner(Z), vbDirectory)
Do Until Datei = ""
If InStr(Datei, ".") = 0 Then
intK = intK + 1
ReDim Preserve arrOrdner(1 To intK)
arrOrdner(intK) = arrOrdner(Z) & Datei & "\"
End If
Datei = Dir
Loop
Next
If intE  "" Then
'Alle Ordner durchsuchen
For Each varOrdner In arrOrdner
Datei = Dir(varOrdner & Z & "*.*")
Do While Len(Datei) > 0
Select Case Right(Datei, 4)
Case ".pdf", ".dxf", ".dwg"
FileCopy varOrdner & Datei, PfadNew & Datei
Case Else
'nichts
End Select
Datei = Dir() ' nächste Datei
Loop
Next
End If
Next
Err.Clear
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description: Err.Clear
End Sub

Wenn in den Ordnern des Suchpfades sehr viele Dateien vorhanden sind, dann sollte eine andere/effectivere Methode (via "Scripting.FileSystemObject") gewählt werden um die Unterordner zu ermitteln. Denn jetzt werden über DIR alle Dateien+Ordner geprüft.
Gruß
Franz
Anzeige
AW: Verknüpfung Dateipfad
22.03.2018 08:20:22
Rene
Hallo Franz, danke für die Hilfe und Info bzgl. vieler Dateien in den Unterordnern. In der Tat sind es recht viele Daten. Ich werde heute mal einen ersten Test im richtigen Laufwerk starten um zu sehen wie die "Performance" ist. In der Zwischenzeit versuche ich gerade Checkboxen mit der select case Funktion zu verknüpfen, denn ein Vorauswahl an zu kopierenden Dateitypen wäre sinnvoller als alles zu kopieren.
Folgender Ausschnitt läuft nicht ganz. Ich kann doch mehrerer Case Werte setzen oder?
Select Case Right(Datei, 4)
If CheckBox1.value = True Then case 1
End If CheckBox2.value = True Then case 2
Case 1, ".PDF"
Case 2, ".dwg"
Vg
René
Anzeige
AW: Verknüpfung Dateipfad
22.03.2018 11:03:14
UweD
Hallo
&gt Ich kann doch mehrerer Case Werte setzen oder?
Mit Selcet case kann man nichts setzen. Es ist eine elegante Art mehrere IF / Then -Abfragen zu gestalten.


so ginge es
    Select Case Right(Datei, 4)
        Case ".pdf", ".dxf", ".dwg"
            With UserForm1
                If .CheckBox1 Or .CheckBox2 Or .CheckBox3 Then _
                    FileCopy varOrdner & Datei, PfadNew & Datei
            End With
        Case Else
            
            'nichts 
            
    End Select

LG UweD
Anzeige
AW: Verknüpfung Dateipfad
22.03.2018 12:11:32
Rene
Hallo Uwe,
wenn ich die Checkboxen wie in deinem Beispiel verwende haben sie keine Funktion. Es werden immer alle Formate gesucht egal ob ich ein Haken setze oder nicht.
Im UF möchte ich den Haken setzen für das jeweilige Format und nur dieses Format soll dann gesucht werden.
Könnte ich das so abändern:
Select Case Right(Datei, 4)
Case ".pdf"
With UserForm1
If .CheckBox1.Value = True Then _
FileCopy varOrdner & Datei, PfadNew & Datei
End With
Case Else
Gruß
René
AW: Verknüpfung Dateipfad
22.03.2018 12:25:01
Rene
Habs jetzt so gemacht und es funktioniert. Kann jedes Format auswählen und es wird dann auch nur dieses gespeichert. Ob es elegant ist weiß ich nicht.
Select Case Right(Datei, 4)
Case ".pdf"
With UserForm1
If .CheckBox1.Value = True Then _
FileCopy varOrdner & Datei, PfadNew & Datei
End With
Case Else
'nichts
End Select
Select Case Right(Datei, 4)
Case ".dwg"
With UserForm1
If .CheckBox2.Value = True Then _
FileCopy varOrdner & Datei, PfadNew & Datei
End With
Case Else
'nichts
End Select
Select Case Right(Datei, 4)
Case ".dxf"
With UserForm1
If .CheckBox3.Value = True Then _
FileCopy varOrdner & Datei, PfadNew & Datei
End With
Case Else
'nichts
End Select
Select Case Right(Datei, 4)
Case ".stp"
With UserForm1
If .CheckBox4.Value = True Then _
FileCopy varOrdner & Datei, PfadNew & Datei
End With
Case Else
'nichts
End Select
Anzeige
AW: Verknüpfung Dateipfad
22.03.2018 13:03:01
UweD
Dann doch bitte so
    Select Case Right(Datei, 4)
        Case ".pdf"
            If UserForm1.CheckBox1 Then _
                FileCopy varOrdner & Datei, PfadNew & Datei
        
        Case ".dwg"
            If UserForm1.CheckBox2 Then _
                FileCopy varOrdner & Datei, PfadNew & Datei
    
        Case ".dxf"
            If UserForm1.CheckBox3 Then _
                FileCopy varOrdner & Datei, PfadNew & Datei

        Case ".stp"
            If UserForm1.CheckBox4 Then _
                FileCopy varOrdner & Datei, PfadNew & Datei
        Case Else
    
            'nichts 
    End Select


oder
    If Right(Datei, 4) = ".pdf" And UserForm1.CheckBox1 Or _
       Right(Datei, 4) = ".dwg" And UserForm1.CheckBox2 Or _
       Right(Datei, 4) = ".dxf" And UserForm1.CheckBox3 Or _
       Right(Datei, 4) = ".stp" And UserForm1.CheckBox4 Then

            FileCopy varOrdner & Datei, PfadNew & Datei
            
    End If

LG UweD
Anzeige
AW: Verknüpfung Dateipfad - Variante für Select c
22.03.2018 17:46:27
fcs
Hallo René,
hier noch eine Variante wie man hier die Select Case eleganter/kompakter aufbauen kann.
Innerhalb des Code-Moduls für Userform1 kannst du Userform1 auch durch Me ersetzen.
Gruß
Franz
    Dim bolCopy As Boolean
bolCopy = False
Select Case Right(Datei, 4)
Case ".pdf":  bolCopy = UserForm1.CheckBox1
Case ".dwg":  bolCopy = UserForm1.CheckBox2
Case ".dxf":  bolCopy = UserForm1.CheckBox3
Case ".stp":  bolCopy = UserForm1.CheckBox4
End Select
If bolCopy = True Then
FileCopy varOrdner & Datei, PfadNew & Datei
End If

Anzeige
AW: Verknüpfung Dateipfad - Variante für Select c
26.03.2018 09:26:27
Rene
Morgen zusammen,
danke fürs zusammenfassen der "case" Funktion.
Bin leider noch nicht dazu gekommen diese auszuprobieren ggf. wird's heute Abend was werden.
vg
René

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige