einzelne Datei im neu erstellten Ordner umbenennen
29.02.2024 13:24:40
JoFr
Ich erstelle per VBA einen neuen Ordner aus einer Excelliste.
Dieser Ordner ist eine Kopie aus einem Vorlagenordner mit Unterordnern und einer Excelliste.
Der Ordnername wird aus Zellen der Excelliste erstellt und sieht wie folgt aus: Nummer_Ort_Tätigkeit.
Das funktioniert auch sehr gut.
Jetzt möchte ich die Excelliste im neuen Ordner gleich umbenennen an Hand des Ordnernamens.
Der Ordnername sollte wie folgt aussehen: Nummer_Ort_Tätigkeit_Logbuch.xlsm.
Gibt es da eine Möglichkeit?
Dankeschön.
Mein Code:
Option Explicit
' Ein neuer Ordern wird im Ordner "Kabelarbeiten" erstellt als Kopie des Ordners "01_Vorlage"
' Die Benennung erfolgt aus den Spalten C & E & H
Sub Modul1Ordner_erstellen()
Dim varMaster As String, varVorlage As String, varSpalten As String, varNeu As String, varSpalteC As String
Application.ScreenUpdating = False
Application.EnableEvents = False
varMaster = "\\dbsw.sharepoint.com@SSL\DavWWWRoot\sites\KTTeamRegionNordKabe\Freigegebene Dokumente\Bremen\Kabelarbeiten\"
varVorlage = varMaster & "01_Vorlage"
varSpalten = Cells(ActiveCell.Row, 3).Value & " _ " & Cells(ActiveCell.Row, 5).Value & " _ " & Cells(ActiveCell.Row, 8).Value
varSpalteC = Cells(ActiveCell.Row, 8).Value
varNeu = varMaster & varSpalten
If Dir(varNeu, 16) = "" Then
CreateObject("Scripting.FileSystemObject").CopyFolder varVorlage, varNeu 'kopieren und _umbenennen
Cells(ActiveCell.Row, 3).Select 'auswahl aktive Zelle,Spalte "C"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=varNeu 'anlegen Hyperlink von Zelle nach neuer Ordner
MsgBox "Der Ordner:" & vbLf & vbLf & varSpalten & vbLf & vbLf & "wurde angelegt.", vbOKOnly, _
"Kabelarbeit" 'angelegt
Else
MsgBox "Der Ordner:" & vbCr & vbCr & varSpalten & vbCr & vbCr & " ist bereits vorhanden!", _
vbCritical, "Kabelarbeit" 'vorhanden
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Anzeige