Office: Ordner suchen und als Pfad für SaveAs nutzen

soweitsogut · 14. Oktober 2014

Hallo zusammen,

die aktive Excel Datei (erzeugt aus einer Vorlage) soll nach Maskeneingabe per Script gleich gespeichert werden können.

Das mache ich aktuell mit
Code:

Application.Dialogs(xlDialogSaveAs).Show "\\ServerA\Verzeichnis1\ANGEBOTE\Ang2014\" & dateiname
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

"Natürlich" soll eigentlich nicht im angegebenen Pfad gespeichert werden, sondern erst nach Auswahl des richtigen Unterordners.

Hierfür gibt es die 2 Werte Kundenname und Angebotsnummer, die zur Suche sinnvoll sind, da die Unterordner (sofern sie bereits existieren) ebenso wie folgt benannt wären: \Kundenname***\Angebotsnummer-***\

Ist ein Ordner vorhanden, der auf die Angebotsnummer beginnt, soll dieser Ordner zu meinem bisher vordefinierten Pfad beim Save as werden. Wenn dieser nicht existiert, soll der Ordner gewählt werden, der mit dem Kundennamen beginnt.

Ich finde keine bestehenden Beitrag, der nach Ordnern selbst sucht und sich den Pfad des (ersten) Suchtreffers merkt.

Danke Euch vorab
soweitsogut

:)

haklesoft · 16. Oktober 2014

Dieses Thema haben wir aber schon öfter behandelt. Siehe z.B. hier

Und wenn Du den Pfad und Dateinamen bereits vorliegen hast, dann speichere doch direkt nach der festgelegten Systematik, ohne den Anwender noch extra zu fragen.

soweitsogut · 16. Oktober 2014

Hallo Haklesoft,

so einfach ist das nicht.
Für die Erstellung der Ordner gibt es Vorgaben, aber die sind nicht so eindeutig, das man den genauen Ordnername kennt, sondern eben nur einn Teilstring des Ordnernamens.

Beispiel Kunde wäre SIEMENS.
Ordername könnte aber \SIEMENS-AG\ sein.

Dito bei der Angebotsnummer.

Zudem können die Ordner der Angebotsnummer direkt unter dem Ordner der Firma sein, aber ebenso noch eine Ebene tiefer
\SIEMENS-AG\Angebotsnummer-Angebotsbeschreibung\
oder
\SIEMENS-AG\Projekte\Angebotsnummer\

Ich muß also jeden einzelnen existierenden Ordnername prüfen ob im Pfad dieses Ordners mein Suchkriterium enthalten ist.

Gruß soweitsogut

haklesoft · 16. Oktober 2014

Hallo soweitsogut,

Ich muß also jeden einzelnen existierenden Ordnername prüfen ob im Pfad dieses Ordners mein Suchkriterium enthalten ist
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Probier doch mal, ob Du mit diesem Modul-Code die gesuchten Verzeichnisse ermitteln kannst: Code:

Option Explicit

Function getAblagepfad(Optional sBasis As String, Optional sKunde As String, Optional sAngNr As String) As String
Dim colBasis As New Collection
Dim colKunde As New Collection
Dim colAngNr As New Collection
Dim lBasis As Long, lKunde As Long
Dim i As Long
Const cDEBUG As Boolean = True 'oder False, um die Debug.Print's zu unterdrücken

'### Die Suche in C:\Users steht hier nur als Beispiel drin !!!
'Es dauert schon einige Sekunden, bis über 4.440 Verzeichnisse durchsucht sind
'Bei individuellen Verzeichnissen geht es deutlich schneller
If Len(sBasis) < 2 Then sBasis = "C:\Users" 'ohne abschl. BS
If Len(sKunde) < 1 Then sKunde = "\Pub" 'mit führendem BS
If Len(sAngNr) < 1 Then sAngNr = "\Doc" 'mit führendem BS

lBasis = Len(sBasis)
lKunde = Len(sKunde)

'alle Verzeichnisnamen im Basispfad ermitteln
getAllDirs sBasis, colBasis
If cDEBUG = True Then Debug.Print "Anzahl Verzeichnisse im Basispfad", , colBasis.Count

If colBasis.Count > 0 Then
'prüfen, ob sKunde in den Verzeichnissen enthalten ist
For i = 1 To colBasis.Count
If InStr(lBasis, colBasis(i), sKunde, vbTextCompare) > 0 Then
'alle Pfade übernehmen, die das erste Kriterium erfüllen
colKunde.Add colBasis(i)
End If
Next i
If cDEBUG = True Then Debug.Print "Anzahl Kundenverzeichnisse", , , colKunde.Count
If colKunde.Count > 0 Then
For i = 1 To colKunde.Count
If InStr(lBasis + lKunde, colKunde(i), sAngNr, vbTextCompare) > 0 Then
'alle Pfade übernehmen, die auch das zweite Kriterium erfüllen
colAngNr.Add colKunde(i)
End If
Next i
If cDEBUG = True Then Debug.Print "Anzahl Kundenverzeichnisse mit Angebotsnummer", colAngNr.Count
If colAngNr.Count > 0 Then
'ersten Nummernpfad zurückliefern
getAblagepfad = colAngNr(1)
'es könnte aber weitere Nummernpfade geben
For i = 1 To colAngNr.Count
If cDEBUG = True Then Debug.Print "Nummernpfad " & i, colAngNr(i)
Next i
Else
'Kein Nummernpfad, ersten Kundenpfad zurückliefern
'Hier wird nicht mehr abgeklärt, ob es weitere Kundenpfade gibt
getAblagepfad = colKunde(1)
End If
Else
MsgBox "Kein Kundenverzeichnis im Basispfad gefunden", vbCritical, "Fehlerhinweis"
End If
Else
MsgBox "Keine Unterverzeichnisse im Basispfad gefunden", vbCritical, "Fehlerhinweis"
End If
End Function

'Die rekursive Sub trägt in einer Collection alle Verzeichnisse eines Pfadbaumes ein
Sub getAllDirs(sPath As String, colDirs As Collection)
Dim sTemp As String, sRepeat As String
On Error Resume Next
If Right(sPath, 1) "\" Then sPath = sPath & "\"
sTemp = Dir(sPath, vbDirectory)
Do While Len(sTemp)
If (sTemp ".") And (sTemp "..") Then
If (GetAttr(sPath & sTemp) And vbDirectory) = vbDirectory Then
colDirs.Add sPath & sTemp
getAllDirs sPath & sTemp, colDirs
sRepeat = Dir(sPath, vbDirectory)
Do While sRepeat sTemp
sRepeat = Dir()
Loop
End If
End If
sTemp = Dir()
Loop
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

soweitsogut · 17. Oktober 2014

Hallo haklesoft,

Chapeau!
merci, thanks, köszönöm, DANKE.

Läuft super.

Berichtigend meinerseits sei aber gesagt, das mein Aufruf für das SaveAs nicht sauber war.

So aber klappt es
Code:

'Ablagepfad der Form "\V:\Verzeichnis1\ANGEBOTE\Ang2014\sKunde\sAngNr
ChDrive Left(Ablagepfad, 3)
ChDir Right(Ablagepfad, Len(Ablagepfad) - 2)
DlgAnswer = Application.GetSaveAsFilename(InitialFileName:=dateiname, _
fileFilter:="Microsoft Excel-Arbeitsmappe (*.xls), *.xls")
If DlgAnswer "Falsch" Then
ActiveWorkbook.SaveAs Filename:=dateiname, FileFormat:=xlNormal
End If
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Thema ist hiermit geschlossen.
soweitsogut

Office: Ordner suchen und als Pfad für SaveAs nutzen

Ordner suchen und als Pfad für SaveAs nutzen

Ordner suchen und als Pfad für SaveAs nutzen

Ordner suchen und als Pfad für SaveAs nutzen

Ordner suchen und als Pfad für SaveAs nutzen - Similar Threads - Ordner Pfad SaveAs

Outlook - Ordner gesendete Elemente wechseln

Öffentlicher Ordner Kontakte aktualisieren

Nach einer Datei suchen in mehreren Ordnern?

Ordner: Synchronisierungsprobleme

Datei in mehreren Ordnern suchen und wenn gefunden öffnen?! Macro / VBA

Outlook 2019: Schriftart der Ordner/Posteingang ändern

Ordner auslesen Pfad + Datei als hyperlink