kann man auch einen Ordner im Ordner durchsuchen?
18.01.2007 20:00:37
fuzzi
Ist:
Mein Makro durchsucht einen Ordner (fertigzustellende Rechnungen) um dort die bislang höchste fortlaufende Zahl zu finden.
Diese wird dann um eins erhöht und in den Namen einer neuen Datei eingesetzt (hinter dem Inhalt der Zelle D82).
Diese wird in dem ersten Ordner abgespeichert.
Soll:
Kann man das so ändern, dass ein darin befindlicher Unterordner (abgeschickte Rechnungen) mit durchsucht wird? Dorthin muß ich die Dateien nämlich teilweise verschieben (Wenn es die höchste Nummer ist, kann das Makro sie nicht mehr im ersten Ordener (fertigzustellende Rechnungen)finden und vergibt diese Nummer noch einmal. 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