PDA

Vollständige Version anzeigen : zu Verzeichnis wechseln


Aang39
11.07.2012, 08:18
Hallo zusammen ....

ich habe folgendes Problem :

ich möchte das per VBA das meine Arbeitsmappe in das Verzeichnis gespeichert wird, dass in einer Zelle vorgegeben ist.

z.B. Zelle A1 = Auto --> Speichern unter ../../Auto

Den Code das er mir das Hauptverzeichnis angibt hab ich schon :

Dim oFileDialog As FileDialog
Dim Pfad As String


Pfad = "X:\Allgemeine Informationen\GERÄTENACHWEISE\Austausch\Gerätenachweise_2012\"

Set oFileDialog = Application.FileDialog(msoFileDialogSaveAs)


With oFileDialog


.ButtonName = "Speichern unter"
.InitialFileName = Pfad & Cells(6, 3) & "_" & Cells(11, 5) & "_" & Cells(9, 3) & "_" & Cells(10, 3) & "_" & Cells(10, 12)
.Show
.FilterIndex = 2
.Execute

For Each vrtSelectedItem In .SelectedItems
DatenSpeichern = vrtSelectedItem

Next

End With



End Sub

Aber nun soll er auch weiter in das angegebe Verzeichniss springen

X:\Allgemeine Informationen\GERÄTENACHWEISE\Austausch\Gerätenachweise_2012\Auto

Das er sich die Info aus der Zelle hohlt ist nicht das Problem ... Nur hängt er es dann an den Dateinamen an - und springt nicht in das Verzeichnis :rolleyes:

Vielen Dank im Voraus

IngGi
11.07.2012, 10:40
Hallo,

... Nur hängt er es dann an den Dateinamen an - und springt nicht in das Verzeichnis ...

Wo macht er das? Ich kann in deinem Code nirgends einen Bezug auf eine Zelle A1 mit dem Unterverzeichnis finden.

Gruß Ingolf

Aang39
11.07.2012, 11:08
Das mit dem "Auto" ist ein Beispiel !
Und es ist auch nicht Zelle "A1" .....

ich hab ja den ZielPfad angegeben

Pfad = "X:\Allgemeine Informationen\Nachweis\Austausch\Gerätenachweise_2012\"

.. und ich hab ein Verzeichniss mit diversen Unterordnern :

Austausch ( Hauptordner )

(Unterordner) --> Auto
--> Fahrrad
--> Flugzeug

Die Ordnerbezeichnungen sind die ersten Stellen einer Zuweisung ( z.B. Auto0001 ).
Das Excel mir jetzt die ersten 4 Stellen ausliest bekomme ich hin ( Range(1, 4).Value) ... Jetzt soll er bei "Speichern Unter" direkt in den Ordner ( in diesem Falle AUTO springen, damit ich die Arbeitsmappe dort abspeichern kann !

ASE
11.07.2012, 11:27
Hallo,
Pfad =Worksheets("Tabelle1").Range("A1").Value
'dann prüfen ob Backlash gesetzt wurde
If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\"
'wenn weitere Unterverzeichnisse dazu sollen

Pfad =Pfad & Worksheets("Tabelle1").Range("A2").Value
' und wieder prüfen!
If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\"

wenn Du den Pfad vollständig angegeben hast, brauchst Du nur einmal die Prüfung. Oder Du stellst sicher das ein \ vorhanden ist.

Aang39
11.07.2012, 13:57
@ASE

SUPER DANKE SPITZE :grins:

Habs für meine Zwecke angepast und es funzt super .....
.... darauf wäre ich nie gekommen - hab schon einieges ausprobiert. (warscheinlich deswegen)

Grüße

Aang39
12.07.2012, 11:02
Hallo Gemeinde ... ich muss da nochmal etwas "nerven" ! :eek:

Wie kann ich zu dem obrigen Code noch hinzufügen , das er Prüfen soll ob der Ordner vorhanden ist ?
Wenn ja soll er speicher , wenn nein soll er den Ordner erstellen --> dorthin wechseln und dann speichern.

Das was ich als Lösung bis jetzt gefunden habe ist leider etwas "unproduktiv", da er immer erst speichert und dann prüft ob der Ordner vorhanden ist ! :(

Nach einigem Rumprobieren und scheitern , hab ich dann folgendes gefunden :

Sub SpeichernMitOrdnerErstellen()
'testet, ob Ordner existiert, und erstellt ihn notfalls, öffnet dann Speichern-Dialog

Dim SpVerz As String
Dim Reakt As Integer

SpVerz = InputBox(Prompt:="Geben Sie den gewünschten Pfad ein!")
If SpVerz = "" Then Exit Sub

If Right(Trim(SpVerz), 1) <> "\" Then
SpVerz = SpVerz & "\"
End If

If Not IsDiskFolder(SpVerz) Then
Reakt = MsgBox(Prompt:="Der Ordner " & SpVerz & " existiert nicht!" & Chr(13) & _
"Möchten Sie ihn jetzt erstellen?", Buttons:=vbYesNo + vbInformation)
If Reakt = vbYes Then
MkDir SpVerz
ChDir SpVerz
Else
Exit Sub
End If
End If

Dialogs(wdDialogFileSaveAs).Show

End Sub
Function IsDiskFolder(ByVal fName As String) As Boolean
'liefert True zurück, wenn der Ordner existiert

If (Dir(fName, vbDirectory) <> "") Then
IsDiskFolder = True
Else
IsDiskFolder = False
End If


Hilft aber auch nicht wirklich , weil er es speichert und dann prüft.

Vielen Dank