24.07.2020, 21:00 (Dieser Beitrag wurde zuletzt bearbeitet: 24.07.2020, 22:43 von Kuwer.)
Hallo alle zusammen.
Eins vorweg ich kenne mich absolut nicht in VBA aus :)
Ich habe folgen Tabelle in Excel (siehe Ende)
Die Dateien liegen alle in einem Ordner.
Ich möchte jetzt das Excel mit hilfe von VBA den Ordner 1 erstellt und die Dateien 1 - 12 dort reinkopiert, dann Ordner 2 mit Dateien 13 - 20 usw.
Außerdem soll angezeigt werden wenn eine Datei nicht gefunden.
Würde sowas gehen und wie müsste der Code aussehen, habe mich schon durch so viele Codes und Hilfen gelesen, aber ich verstehe es einfach nicht.
Sub DateienKopieren()
Dim strPfad As String
Dim strZieldatei As String
Dim strZielordner As String
Dim rngDatei As Range
strPfad = "F:\Uwe\Documents\Excel\Foren\CEF\Ordner0\" 'anpassen!
For Each rngDatei In Cells(1, 2).CurrentRegion.Columns(2).Cells
strZieldatei = rngDatei.Value
If Dir(strPfad & strZieldatei) = strZieldatei Then
strZielordner = rngDatei.Offset(, -1).MergeArea(1).Value
If Dir(strPfad & strZielordner, vbDirectory) = "" Then
MkDir strPfad & strZielordner
End If
FileCopy strPfad & strZieldatei, strPfad & strZielordner & "\" & strZieldatei
Else
rngDatei.Font.Strikethrough = True
End If
Next rngDatei
End Sub
Ich habe noch eine kleine bitte.
Sind leider 2 Sachen.
Das der Dateiname nicht durchgestrichen wird sondern in der Zelle neben dran nicht vorhanden steht.
Eine Datei sieht wir folgt aus:
RL5_5M_IZ5U1PX_V3.xls
Jetzt ist es so das die Versionen sich ändern können, das heißt hinten würde anstatt V3 jetzt V4 stehen.
Was sich nie ändert ist der 3. Block (IZ5U1PX) aber dort ohne das "I" also Z5U1PX. würde das auch gehen wenn nur das abgefragt werden würde und wenn ja wie?? :)
25.07.2020, 15:52 (Dieser Beitrag wurde zuletzt bearbeitet: 25.07.2020, 15:52 von Kuwer.)
Hallo,
teste mal damit:
Sub DateienKopieren_2()
Dim rngDatei As Range
Dim strPfad As String
Dim strZieldatei As String
Dim strZielordner As String
Dim varTemp As Variant
strPfad = "F:\Uwe\Documents\Excel\Foren\CEF\Ordner0\" 'anpassen!
For Each rngDatei In Cells(1, 2).CurrentRegion.Columns(2).Cells
varTemp = Split(rngDatei.Value, "_")
If UBound(varTemp) = 3 Then
strZieldatei = Dir(strPfad & "*_?" & Mid(varTemp(2), 2) & "_*")
If Len(strZieldatei) Then
strZielordner = rngDatei.Offset(, -1).MergeArea(1).Value
If Dir(strPfad & strZielordner, vbDirectory) = "" Then
MkDir strPfad & strZielordner
End If
FileCopy strPfad & strZieldatei, strPfad & strZielordner & "\" & strZieldatei
rngDatei.Offset(, 1).Value = strZieldatei & " kopiert"
Else
rngDatei.Offset(, 1).Value = "nicht vorhanden"
End If
Else
rngDatei.Offset(, 1).Value = "ungültiger Dateiname"
End If
Next rngDatei
End Sub
