Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
836to840
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
836to840
836to840
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

durchsuchen eines Unterordners

durchsuchen eines Unterordners
16.01.2007 21:31:26
fuzzi
Hallo liebe Experten!
Mein Makro durchsucht einen Ordner (fertigzustellende Rechnungen) um dort die bislang höchste fortlaufende Zahl zu finden, und dann um eins eröht eine neue Tabelle abzuspeichern.
Kann man das so ändern, dass ein darin befindlicher Unterordner mit durchsucht wird? Dorthin muß ich die Dateien nämlich teilweise verschiebe. Danke für die Hilfe hier mein derzeitiger Code:

Sub speichern_unter()
Dim strOrdn As String, intN As Integer, strName As String, strTxt As String
Dim strFile As String
strOrdn = "D:\Eigene Dateien\Ordi\Buchhaltung\fertigzustellende Rechnungen"
If UCase(Range("c2")) = "X" Then
strOrdn = strOrdn & " L\"
ElseIf UCase(Range("c3")) = "X" Then
strOrdn = strOrdn & " VB\"
Else
MsgBox "Zuordnung Linz - VB nicht korrekt"
Exit Sub
End If
strFile = Dir(strOrdn & Cells(82, 4) & "*.xls")
If strFile > "" Then
Application.DisplayAlerts = True ' False wenn ohne Warnung überschrieben werden soll
ActiveWorkbook.SaveAs filename:=strFile ' wenn es "Name Vorname*.xls" schon gibt
Application.DisplayAlerts = True  ' wenn ohne Warnung überschrieben wurde
Else
HoleNr strOrdn, strTxt, intN            ' neuen Dateinamen bestimmen
If intN >= 0 Then _
ActiveWorkbook.SaveAs filename:= _
strOrdn & Cells(82, 4) & " " & strTxt & "-" & Format(intN, "000") & ".xls"
End If
End Sub


Sub HoleNr(strOrdner As String, strText As String, intMax As Integer)
Dim objFSO As Object, objFol As Object, objFile As Object
Dim intNr As Integer, strTn As String
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFol = objFSO.GetFolder(strOrdner)
For Each objFile In objFol.Files
'abcd xyz 2006-04-556.xls
If objFile.Name Like "* ####-##-###.xls" Then
strTn = Left(Right(objFile.Name, 15), 7)
Select Case strText
Case strTn
Case "":          strText = strTn
Case Is <> strTn
intMax = -1
MsgBox "In '" & strOrdner & "' stehen Dateien zu verschiedenen Monaten.", _
vbCritical, "Abbruch"
Exit Sub
End Select
intNr = Left(Right(objFile.Name, 7), 3)
If intMax < intNr Then intMax = intNr
End If
Next objFile
intMax = intMax + 1
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
DOPPELT (oT)
18.01.2007 22:30:30
Erich
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige