|
New user
Beiträge: 4
| Hallo zusammen,
mein Name ist Andreas und ich benötige eure Hilfe bei einem VBACode.
Bisher habe ich in unserer DB Unterordner über folgenden VBA Code angelegt. Das Problem ist nur der Ordner ist mittlerweile so groß das es Minuten dauert bis ein Ordner angelegt wird.
Private Sub Ablage_erstellen_Click()
On Error GoTo Ende
DoCmd.RunCommand acCmdSaveRecord
Dim strpfad As String
Dim I As Integer
strpfad = "\\Pfadangabe\" & Me![txt_Auftrag] & " - " & [Baugruppe] & " -Nr. " & [Teile Nr]
If Dir(strpfad, vbDirectory) = "" Then
I = MsgBox("Das Verzeichnis ist nicht vorhanden" & Chr(10) _
& "Soll es angelegt werden?", vbYesNo)
If I = vbNo Then Exit Sub
If I = vbYes Then
Me!Ablage = "A"
If Not Exist_Ordner(strpfad) Then
Create_Ordner (strpfad)
End If
strpfad = "\\Pfadangabe\" & Me![txt_Auftrag] & " - " & [Baugruppe] & " -Nr. " & [Teile Nr] & "\Messblatt"
If Not Exist_Ordner(strpfad) Then
Create_Ordner (strpfad)
End If
strpfad = "\\Pfadangabe\" & Me![txt_Auftrag] & " - " & [Baugruppe] & " -Nr. " & [Teile Nr] & "\Prüfprotokoll"
If Not Exist_Ordner(strpfad) Then
Create_Ordner (strpfad)
End If
strpfad = "\\Pfadangabe\" & Me![txt_Auftrag] & " - " & [Baugruppe] & " -Nr. " & [Teile Nr] & "\Übergabe und interne Unterlagen"
If Not Exist_Ordner(strpfad) Then
Create_Ordner (strpfad)
End If
strpfad = "\\Pfadangabe\" & Me![txt_Auftrag] & " - " & [Baugruppe] & " -Nr. " & [Teile Nr] & "\Unterbaugruppen"
If Not Exist_Ordner(strpfad) Then
Create_Ordner (strpfad)
End If
strpfad = "\\Pfadangabe\" & Me![txt_Auftrag] & " - " & [Baugruppe] & " -Nr. " & [Teile Nr]
If Not Exist_Ordner(strpfad) Then
Create_Ordner (strpfad)
End If
' MkDir (strpfad)
DoCmd.Hourglass True ' Auf die Sanduhr kann auch verzichtet werden
Sleep 3000 '3 sec
DoCmd.Hourglass False
Shell "Explorer.exe " & strpfad, vbNormalFocus
Else
MsgBox "Aktion abgebrochen!"
End If
Else
Shell "Explorer.exe " & strpfad, vbNormalFocus
End If
DoCmd.RunCommand acCmdSaveRecord
Me.Refresh
Ende:
'MsgBox Err.Description
End Sub
Zukünftig möchte ich die Ordner wie folgt anlegen lassen.
Ordner mit Name des Auftrags ist vorhanden dann Unterordner anlegen. Bedeutet es muss geprüft werden ist der Ordner des Auftrags vorhanden falls ja Unterordner anlegen falls nicht Auftragsordner anlegen und dann die Unterordner.
Alle Aufträge habe eine ID und einen txt Auftrag der Begriff Pfadangabe im VBA Code ist nur ein Platzhalter da ich den Pfad nicht öffentlich machen kann.
Leider ist es mir bisher nicht gelungen den Code so abzuändern das ich zum gewünschten Ergebniss komme daher wende ich mich an euch mit der Bitte mir bei der Änderung zu helfen.
Für eure Mühe und Hilfe bedanke ich mich im Voraus
Gruß Andreas
| |
|
Unterordner in bestehende Ordner Anlegen