Ordner benamen mit VBA

Computer: Software & Programmierung Visual Basic
#1

Hallo zusammen,

erzeuge neue Ordner auf Laufwerk per Button. Code siehe unten -->

Private Sub CommandButton7_Click()
Dim strDirPath As String
strDirPath = „C:“ & Me!ComboBox6 & " - " & „KW“ & TextBox40 & " - " & Format(Date, „ddmmyy“)
If Dir(strDirPath, vbDirectory) = „“ Then
MkDir strDirPath
txtSpeicherPfad = strDirPath
Else
MsgBox „Ordner schon vorhanden“
End If
End Sub

Mein Problem ist - wenn der Ordner schon vorhanden ist, meldet er mir ja „Ordner schon vorhanden“ , was auch ganz nett ist aber - er soll mir wenn der Ordner schon vorhanden ist nach C:" & Me!ComboBox6 eine Zahl sprich „1“ angeben & " - "…

Würde dann so aussehen --> [ComboBox6]Firma Müller_1 - [Textbox40] KW38 und dann das Datum.
Das ist eher kein Prblem - NUR wenn Firma Müller_1 schon vorhanden dann soll er mit Firma Müller_2 machen. Und so weiter
Muss ich hier ne Scheife setzen?
Hat jemand ne Idee wie ich das verwirklichen könnte?

Gruß Rolf

#2

Ordner benamen mit VBA - Erster Versuch
So funktioniert es das er mir den Ordern 1 mitanlegt -->

_Private Sub CommandButton7_Click()
Dim strDirPath As String
Dim strDirPath1 As String

strDirPath = „C:“ & Me!ComboBox6 & " - " & „KW“ & TextBox40 & " - " & Format(Date, „ddmmyy“)
strDirPath1 = „C:“ & Me!ComboBox6 & „_1“ & " - " & „KW“ & TextBox40 & " - " & Format(Date, „ddmmyy“)

If Dir(strDirPath, vbDirectory) = „“ Then
MkDir strDirPath
txtSpeicherPfad = strDirPath
Else
MsgBox „Ordner schon vorhanden - Mit neuer Nummerierung angelegen?“, vbOKCancel, „Beenden“
txtSpeicherPfad = strDirPath1
MkDir strDirPath1

End If

End Sub_

Wenn aber der Order_1 schon vorhanden ist soll er mir den Ordner_2 anlegen. oder _3 oder _4 (kann eben vorkommen das die Ordner schon vorhanden sind…klinkt blöd ist aber leider so :frowning: )

Gruß Rolf

#3

Wenn aber der Order_1 schon vorhanden ist soll er mir den
Ordner_2 anlegen. oder _3 oder _4 (kann eben vorkommen das die
Ordner schon vorhanden sind…klinkt blöd ist aber leider
so :frowning: )

Hi Rolf,

benutze beim Posten von Code den Pre-Tag, wird unterhalb des Eingabefensters erläutert.

Ich weiß nicht wie du die Kalenderwoche berechnset, die kalenderwoche-Funktion von Excel rechnet falsch.

Ungetestet:

Private Sub CommandButton7\_Click()
Dim strDirPath As String, N As Long, eing
strDirPath = "C:\" & Me!ComboBox6 & " - " & "KW" & TextBox40 & " - " & Format(Date, "ddmmyy")
If Dir(strDirPath, vbDirectory) = "" Then
 MkDir strDirPath
 txtSpeicherPfad = strDirPath
Else
 While Dir(strDirPath, vbDirectory) ""
 N = N + 1
 strDirPath = "C:\" & Me!ComboBox6 & "\_" & N & " - " & "KW" & TextBox40 & " - " & Format(Date, "ddmmyy")
 Wend
 eing = MsgBox("Ordner schon vorhanden - Mit neuer Nummerierung angelegen?", vbOKCancel)
 txtSpeicherPfad = "Ordner nicht angelegt"
 If eing vbOK Then Exit Sub
 txtSpeicherPfad = strDirPath
 MkDir strDirPath1
End If
End Sub

Gruß
Reinhard

1 Like
#4

Hallo Reinhard,

sorry - werd ich in Zukunft machen.

die KW hol ich mir so -->

Private Function KalenderWoche(Datum As Date) As Integer
 Dim tmp As Double
 tmp = DateSerial(Year(Datum + (8 - Weekday(Datum)) Mod 7 - 3), 1, 1)
 KalenderWoche = (Datum - tmp - 3 + (Weekday(tmp) + 1) Mod 7) \ 7 + 1
 End Function

Dein Code werd ich morgen früh gleich testen, er schaut aber eigentlich gut aus :smile:
While…
stimmt!

Gruß Rolf

[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]

#5

Hallo nochmal,

passt! Funktioniert. Super Danke.

Gruß Rolf

[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]