Ordner prüfen und aus lesen

Hallo zusammen,
Ich bräuchte mal euere Hilfe!!
Ich habe mir ein Rechnungsformular erstellt was soweit auch alles was ich möchte erfüllt.
Nun mein Problem: Das Speichern der Rechnung.
Im Moment benutze ich ein Makro was ich mir zusammengebaut habe, was auch so weit läuft.
Abfrage Anzahl der Dateien im Ordner. Anzahl wir wieder gegeben in Zelle AS30
Wenn Anzahl Dateien und Rechnungsnummer gleich dann Meldung Rechnungsnummer erhöhen. Makro wir abgebrochen
Speicher der Rechnung unter Pfad und Dateiname aus Ordner.
Kann mir jemand helfen das Makro so zu ändern das der nicht die Anzahl der Dateien prüft, sondern einen Teil des Dateinamens (19 001 Name) nur 19 001 sollte diese schon vorhanden sein das Makro abbrechen.
Kann man den Ordner wo die Rechnungen gespeichert sind, so abfragen das mir in einer Zelle immer die högste Rechnungsnummer angezeigt wird.
Ich hoffe das ich mich einiger maßen verständlich machen konnte.
Kann mir jemand dabei helfen?
Hier mein Code:

Sub Rechnung_speichern()
' ComandButton1 Rechnung speichern
' Rechnung speichern
ActiveSheet.Unprotect
Dim FolderPath As String, Path As String, count As Integer
FolderPath = Worksheets("Rechnungsformular").Range("AT1").Text
Path = FolderPath & "\*.xlsm"
Filename = Dir(Path)
Do While Filename  ""
count = count + 1
Filename = Dir()
Loop
Range("AS30").Value = count
If Range("AT30").Value = "0" Then
MsgBox "Rechnungsnummer!"
Exit Sub
End If
Select Case ActiveSheet.Range("AT30").Value
Case 1
End Select
If Range("C24").Value = "" Then
MsgBox "Name fehlt!"
Else
If Range("F28").Value = "" Then
MsgBox "Datum fehlt!"
Else
If Range("C70").Value = "" Then
MsgBox "Zahlbar bis fehlt!"
Else
Dim strDateiName As String, strOrdner As String, strPfad As String
strPfad = Worksheets("Rechnungsformular").Range("AT5")
'strPfad = "E:\Rechnung\"
'strOrdner = Worksheets("Rechnungsformular").Range("AT9").Value
strOrdner = Worksheets("Rechnungsformular").Range("AT7") & "" & Range("AT9").Value
'strOrdner = Worksheets("Rechnungsformular").Range("AT9").Value
strPfad = strPfad & strOrdner & "\"
If Dir(strPfad, vbDirectory) = "" Then
MkDir (strPfad)
End If
strDateiName = Worksheets("Rechnungsformular").Range("F30") & "  " & Format(Range("G30"), "  _
_
_
_
_
_
0000") & "  " & (Range("C24")) & " " & ".xlsm"
ThisWorkbook.SaveCopyAs Filename:=strPfad & strDateiName
Range("C23").Select
End If
End If
End If
End Sub

Vielen Dank erstmal und viele Grüße
Ralf

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Rechnung_speichern() ' ComandButton1 Rechnung speichern ' Rechnung speichern ActiveSheet.Unprotect Dim FolderPath As String, Path As String, count As Integer Dim strNummer As String, iJahr As Integer, iNr As Integer, lngNummer As Long, lngMax As _ Long FolderPath = Worksheets("Rechnungsformular").Range("AT1").Text FolderPath = "C:\Lokale Daten (D)\Test\Ziel" Path = FolderPath & "\*.xlsm" Filename = Dir(Path) lngMax = 0 Do While Filename "" 'Beispiel dateiname: "19 001 Text .xlsm" strNummer = Left(Filename, 7) If strNummer Like "## ###" Then strNummer = Replace(strNummer, " ", "") lngNummer = CLng(strNummer) If lngNummer > lngMax Then lngMax = lngNummer End If count = count + 1 Filename = Dir() Loop strNummer = Format(lngNummer, "00000") iJahr = Val(Left(strNummer, 2)): iNr = Val(Right(strNummer, 3)) MsgBox "Letzte Rechnungsnummer im Ordner " & FolderPath & vbLf & _ Format(iJahr, "00") & " " & Format(iNr, "000") Range("AS30").Value = iNr

Hallo Franz
Erst mal Danke für deine Hilfe.
PS. Bin noch Anfänger
Ich habe deinen Code bei mir eingebaut, und diese Zeile gelöscht.
FolderPath = "C:\Lokale Daten (D)\Test\Ziel"
Das Makro läuft aber noch nicht so ganz wie ich es brauche.
Ich habe mich vielleicht nicht richtig ausgedrückt.
Versuche es nochmal ein bisschen anders aus zu drücken.
Mein Makro hat immer die Anzahl der Dateien gezahlt, und diesen Wert dann in Zelle AS30 geschrieben.
Ich bräuchte es so dass es mir die hogste Jahres Zahl in AS29 schreibt und högste die Rechnungsnummer in AS30 schreibt. Wobei die Priorität auf der Rechnungsnummer liegt.
Die Dateinamen sind so gespeichert
19 0001 Müller
19 0002 Schulze
Ich hoffe es ist ein bisschen verständlicher
Ich hoffe man kann mir helfen.
Gruß Ralf

Sub Rechnung_speichern() ' ComandButton1 Rechnung speichern ' Rechnung speichern ActiveSheet.Unprotect Dim FolderPath As String, Path As String, count As Integer Dim strNummer As String, iJahr As Integer, iNr As Integer, lngNummer As Long, _ lngMax As Long FolderPath = Worksheets("Rechnungsformular").Range("AT1").Text Path = FolderPath & "\*.xlsm" Filename = Dir(Path) lngMax = 0 Do While Filename "" 'Beispiel dateiname: "19 0001 Text .xlsm" strNummer = Left(Filename, 8) If strNummer Like "## ####" Then strNummer = Replace(strNummer, " ", "") lngNummer = CLng(strNummer) If lngNummer > lngMax Then lngMax = lngNummer End If count = count + 1 Filename = Dir() Loop strNummer = Format(lngNummer, "000000") iJahr = Val(Left(strNummer, 2)): iNr = Val(Right(strNummer, 4)) MsgBox "Letzte Rechnungsnummer im Ordner " & FolderPath & vbLf & _ Format(iJahr, "00") & " " & Format(iNr, "0000") ' nur zum Testen Range("AS29").Value = iJahr Range("AS30").Value = iNr 'u.s.w. End Sub

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread