Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
540to544
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
540to544
540to544
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

VBA If-Abfrage für Speicherung

VBA If-Abfrage für Speicherung
04.01.2005 11:31:06
Thorsten
Ich habe mir ein VBA script mal zusammengeschnipselt das
mit einem Speicherbutton das Formular in den richtigen
Ordner Archiviert
Zu erst soll es prüfen ob der Ordner Cells(3, 12) im
überverzeichniss existiert (damit er nicht ordner in
ordner anlegt) wenn ja soll er die darinliegende Datei
überschreiben (wenn der Name der selbe sein sollte)
ansonsten Ordner neu anlegen und Datei mit dem Namen
Cells(2, 15)
mein Problem ist aber, dass das script nicht das macht
was ich mir ausgedacht habe, vieleicht schaut ihr euch es
mal an

Sub Speichern()
uo = Sheets("Berechnungen").Cells(3, 12).Value
dn = Sheets("Berechnungen").Cells(2, 15).Value & ".xls"
ChDir ActiveWorkbook.Path
If Dir(ActiveWorkbook.Path & "\..\" & uo) <> "" Then
fn = ActiveWorkbook.Path & "\" & dn
Else
MkDir ActiveWorkbook.Path & "\" & uo
fn = ActiveWorkbook.Path & "\" & uo & "\" & dn
End If
ActiveWorkbook.SaveAs FileName:=fn, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

MfG Thorsten

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA If-Abfrage für Speicherung
04.01.2005 13:18:21
Matthias
Hallo Thorsten
das Vorhandensei von Verzeichnissen prüft man mit
If Dir(ActiveWorkbook.Path & "\..\" & uo, vbDirectory)  "" Then

Damit kommst du sicher schon mal weiter!
Weil, ich verstehe nämlich nicht ganz... Wenn der Ordner uo im Überordner existiert, soll die Datei hier rein, und wenn nicht, dann in einen Unterordner des aktuellen Ordners?
Gruß Matthias
AW: VBA If-Abfrage für Speicherung
04.01.2005 14:16:23
Thorsten
ja da war ein fehler drin, aber funktionieren tut es deswegen auch noch nicht
zur Funktion mal eine erläuterung:
ich habe eine Vorlage in D:\Arbeitsstunden\Arbeitsstunden.xls
wenn nun jemand die datei editiert gibt er das Jahr an das ist "uo" z.B. 2004
und die Kalenderwoche unter der es gespeichert wird das ist "dn"
wenn er nun auf Speichern klickt soll das Dokument sich automatisch in
D:\Arbeitsstunden\uo\dn schreiben (pfade sollen relative bleiben)
falls jemand aber das Dokument bearbeitet und auf den Speicher button klickt
soll es nicht so einen Ordner erstellen D:\Arbeitsstunden\uo\uo\dn
es soll prüfen ob es den Ordner uo schon im Überverzeichnis gibt und schaun ob die Datei auch schon existiert wenn ja dann soll es diese überschreiben
wenn nein soll es falls der Ordner uo ein anderer ist ihn im überverzeichnis erstellen und die datei dn dort hineinschreiben... so das das Dokument sich automatisch selbst verwaltet, ist ein bischen kompliziert und es funktioniert auch noch nicht richtig ...
zur veranschaulichung hab ich mal die Datei hochgeladen https://www.herber.de/bbs/user/15588.xls

Sub Speichern()
uo = Sheets("Berechnungen").Cells(3, 12).Value
dn = Sheets("Berechnungen").Cells(2, 15).Value & ".xls"
ChDir ActiveWorkbook.Path
If Dir(ActiveWorkbook.Path & "\..\" & uo, vbDirectory) <> "" Then
fn = ActiveWorkbook.Path & "\" & dn
Else
MkDir ActiveWorkbook.Path & "\..\" & uo
fn = ActiveWorkbook.Path & "\..\" & uo & "\" & dn
End If
ActiveWorkbook.SaveAs FileName:=fn, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

Anzeige
AW: VBA If-Abfrage für Speicherung
04.01.2005 14:47:05
Matthias
Hallo Thorsten,
so kompliziert ist das ja gar nicht, es gibt nämlich lt. deiner letzten Beschreibung gar kein "Überordner":
Sub Speichern()
uo = Sheets("Berechnungen").Cells(3, 12).Value
dn = Sheets("Berechnungen").Cells(2, 15).Value & ".xls"
If uo = "" Or dn = ".xls" Then
MsgBox "Fehler! Zellen sind leer!"
Exit Sub
End If
'erstellt Verzeichnis, wenn nötig:
If Dir(ActiveWorkbook.Path & "\" & uo, vbDirectory) = "" Then
MkDir ActiveWorkbook.Path & "\" & uo
End If
'die Datei heißt immer so, egal ob der Unterordner existierte oder nicht!
fn = ActiveWorkbook.Path & "\" & uo & "\" & dn
ActiveWorkbook.SaveAs Filename:=fn, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
Passt es jetzt so?
Gruß Matthias
Anzeige
AW: VBA If-Abfrage für Speicherung
04.01.2005 15:02:19
Thorsten
nicht ganz er legt das verzeichnis uo nochmal an obwohl es im selbigen liegt
D:\Arbeitsstunden\Arbeitsstunden.xls - ich speichere mit dem button dann liegt es in
D:\Arbeitsstunden\uo\dn - ich speicher nochmals mit dem button um es zu testen
dann liegt es in
D:\Arbeitsstunden\uo\uo\dn
verstehst du was ich meine?
AW: VBA If-Abfrage für Speicherung
04.01.2005 15:25:28
Matthias
Hallo Thorsten,
achso, jetzt verstehe ich was du meinst... Der Mappenname wird ja geändert...
Ich habe immer nur nur mit Debug.Print getestet, ohne zu speichern...
Ware es nicht am einfachsten, den Mappenmapen abzufragen, ob er der Vorlagendatei entspricht?
Gruß Matthias
Anzeige
AW: VBA If-Abfrage für Speicherung
Thorsten
also du meinst dn abfragen ob es schon existiert?
ich glaub das sollte auch gehn
aber uo kann sich auch ändern
MfG Thorsten
AW: VBA If-Abfrage für Speicherung
04.01.2005 15:59:00
Matthias
Hallo Thorsten,
ist echt kompliziert...
Am einfachsten wäre es, wenn du den Pfad der VOrlagendatei als Konstante setzen könntest...
aber das geht ja nicht nach deinen Voraussetzungen.
dann könntest du noch prüfen, ob im Verzeichnis der aktiven Mappe der Vorlagenname existiert. Wenn nicht, ein Verzeichnis höher.
Ich habe mal eine Funktion geschrieben, die den übergeordneten Ordner zurückgibt:
Function TopFolder(p As String) As String
Dim l As Integer, i As Integer
Dim found As Boolean
l = Len(p)
found = False
For i = l - 1 To 1 Step -1
If Mid(p, i, 1) = "\" Then Exit For
Next i
If Mid(p, l, 1) = "\" Then i = i + 1
'Debug.Print i
TopFolder = Left(p, i - 1)
End Function
Vielleicht kannst du damit weiterarbeiten...
Ich muss jetzt mal weg...
Viel Erfolg noch,
Matthias
Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige