Excel 2010 - per vba Ordnername in Dateiname einbauen

Question

Hallo Zusammen,

ist es möglich, einen Orndername (Fortlaufende Zahl), in dem die Datei namens Akt.xlsm liegt, in den Dateinamen einzubauen? Soll dann so aussehen: Akt-1.xlsm im Ordner 1., Akt-2.xlsm im Ordner 2 usw.

Gleichzeitig sollte man genau diesen zusammengefügten Namen auch wieder auslesen können.

Vielen Dank schon mal im Voraus für Eure Mithilfe.

Gruß
Florian

Answer 1

hier noch der Code, den ich bislang verwende:

Public Sub OrdnerAnlegen()

Const cstPfad As String = "\\S-file01\ds\Öffentlich\CRM Vertrieb\"

Dim strKundenOrdner As String, strBasisOrdner As String
Dim strAktivitäten As String, strSchriftverkehr
Dim Zelle As Range

With ActiveSheet

strKundenOrdner = .Range("C1")

If Dir$(cstPfad & strKundenOrdner, vbDirectory) = vbNullString Then _
MkDir cstPfad & strKundenOrdner

For Each Zelle In .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))

If Dir$(cstPfad & strKundenOrdner & "\" & Zelle, vbDirectory) = vbNullString Then

strBasisOrdner = cstPfad & strKundenOrdner & "\" & Zelle
strAktivitäten = strBasisOrdner & "\Aktivitäten"
strSchriftverkehr = strBasisOrdner & "\Schriftverkehr"

MkDir strBasisOrdner
MkDir strAktivitäten
MkDir strSchriftverkehr


FileCopy "\\S-file01\ds\Öffentlich\CRM Vertrieb\Inhalt\Akt.xlsm", strAktivitäten & "\Akt.xlsm"

.Hyperlinks.Add Anchor:=Zelle.Offset(0, 2), Address:= _
strAktivitäten & "\Akt.xlsm"

.Cells(Zelle.Row, 15).Formula = "='" & strAktivitäten & "\[Akt.xlsm]Tabelle1'!$J$11"
.Cells(Zelle.Row, 16).Formula = "='" & strAktivitäten & "\[Akt.xlsm]Tabelle1'!$F$1"

'Datei öffnen
Workbooks.Open (strAktivitäten & "\Akt.xlsm")
'Daten kopieren
Workbooks("Akt.xlsm").Worksheets("Tabelle1").Cells(1, 2) = .Cells(Zelle.Row, 3)
Workbooks("Akt.xlsm").Worksheets("Tabelle1").Cells(3, 2) = .Cells(Zelle.Row, 4) & " " & .Cells(Zelle.Row, 5)
Workbooks("Akt.xlsm").Worksheets("Tabelle1").Cells(7, 2) = .Cells(Zelle.Row, 2)

'Akte.xlsm speichern und schließen
With Workbooks("Akt.xlsm")
.Save
.Close
End With

End If
Next Zelle
End With

End Sub

Answer 2

Hallo Florian,

du schreibst:

Soll dann so aussehen: Akt-1.xlsm im Ordner 1., Akt-2.xlsm im Ordner 2 usw.

Der Dateiname kann höchstens so aussehen: Akt-1 im Ordner 1.xlsm, damit die Datei noch als Excel-Datei erkannt wird.
Woher kommt den die Zahl für den Unterordner? Den Namen kannst du ja als Variable zusammensetzen.

Bsp:

Sub test()

Dim strSpeichername As String
Dim lngUnterordner As Long

lngUnterordner = 1

strSpeichername = "Akt-" & lngUnterordner & "_im_Ordner" & lngUnterordner & ".xlsm"

MsgBox strSpeichername

End Sub

Gruß

M.O.

Answer 3

Hallo M.O.

sorry, dass ich mich erst jetzt wieder melde.

Hintergedanke an der Namensstruktur ist dieser, dass ich fortlaufende Nummern für die Ordnernamen habe. Diese werden aus der Exceltabelle übernommen.

Bis jetzt habe ich in jedem Ordner (davon gibt es schon über 100) einen Unterordner mit Namen Aktivitäten und diesem wird automatisch eine als Vorlage gespeicherte Excel-Tabelle mit dem Namen Akt.xlsm kopiert (Dies passiert einmalig bei der Erstellung eines neuen Ordners). Nun habe ich das Problem, wenn ich aus verschiedenen Ordner immer die Akt.xlsm öffne, mir Excel eine Fehler meldung bringt. Deshalb möchte ich dieses umgehen, indem ich in den Dateinamen auch noch den Namen des Übergeordneten Ordners dazu füge.


Im Link habe ich die Ornderstruktur aufgebaut.

Ornderstruktur

Vielen Dank

Gruß Florian

Answer 4

diesem wird automatisch eine als Vorlage gespeicherte Excel-Tabelle mit dem Namen Akt.xlsm kopiert (Dies passiert
einmalig bei der Erstellung eines neuen Ordners).

Hier sollte sich doch was machen lassen lassen.
Denkansatz:
Das Makro, dass den Ordner anlegt und die akt.xlsm kopiert erweitern.
Je nachdem, wie das Makro gestrickt ist entweder per "Speichern unter..." mit neuem Dateinamen oder nachträglichem
Umbenennen per

Ergebnis = Shell("ren alter_name neuer_name", 0)

"ren alter_name neuer_name" ist ein String, den man sich vorher zusammenbasteln kann.

Gruß Flupo

Answer 5

Hallo Florian,

wenn ich das richtig verstanden habe, dann steht die Nummer des Unterordners in der Variable Zelle.

Ich habe den Code mal so umgeschrieben, wie ich glaube, dass er funktionieren könnte (ungetestet):

Public Sub OrdnerAnlegen()

Const cstPfad As String = "\\S-file01\ds\Öffentlich\CRM Vertrieb\"

Dim strKundenOrdner As String, strBasisOrdner As String
Dim strAktivitäten As String, strSchriftverkehr
Dim strDateiname As String
Dim Zelle As Range

With ActiveSheet

strKundenOrdner = .Range("C1")

If Dir$(cstPfad & strKundenOrdner, vbDirectory) = vbNullString Then _
MkDir cstPfad & strKundenOrdner

For Each Zelle In .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))

If Dir$(cstPfad & strKundenOrdner & "\" & Zelle, vbDirectory) = vbNullString Then

strBasisOrdner = cstPfad & strKundenOrdner & "\" & Zelle
strAktivitäten = strBasisOrdner & "\Aktivitäten"
strSchriftverkehr = strBasisOrdner & "\Schriftverkehr"

MkDir strBasisOrdner
MkDir strAktivitäten
MkDir strSchriftverkehr

strDateiname = "Akt-" & Zelle & "im Ordner " & Zelle & ".xlsm"

FileCopy "\\S-file01\ds\Öffentlich\CRM Vertrieb\Inhalt\Akt.xlsm", strAktivitäten & "\" & strDateiname

.Hyperlinks.Add Anchor:=Zelle.Offset(0, 2), Address:= _
strAktivitäten & "\Akt.xlsm"

.Cells(Zelle.Row, 15).Formula = "='" & strAktivitäten & "\[" & strDateiname & "]Tabelle1'!$J$11"
.Cells(Zelle.Row, 16).Formula = "='" & strAktivitäten & "\[" & strDateiname & "]Tabelle1'!$F$1"

'Datei öffnen
Workbooks.Open (strAktivitäten & "\" & strDateiname)
'Daten kopieren
Workbooks(strDateiname).Worksheets("Tabelle1").Cells(1, 2) = .Cells(Zelle.Row, 3)
Workbooks(strDateiname).Worksheets("Tabelle1").Cells(3, 2) = .Cells(Zelle.Row, 4) & " " & .Cells(Zelle.Row, 5)
Workbooks(strDateiname).Worksheets("Tabelle1").Cells(7, 2) = .Cells(Zelle.Row, 2)

'Akte.xlsm speichern und schließen
With Workbooks(strDateiname)
.Save
.Close
End With

End If
Next Zelle
End With

End Sub

Bitte probier das erst einmal in einer Testdatei.

Gruß

M.O.

Answer 6

Hallo M.O.

es funktioniert einwandfrei.

Lediglich beim Hyperlink musste ich noch ausbessern, aber sonst klasse.

Vielen Dank.

Gruß Florian