Clever-Excel-Forum

Hallo miteinander,

ich habe ein Problem. vor einiger Zeit habe ich dank der Hilfe einiger Mitglieder eine Abrufen Datei erstellen können, welche meinen Ordner durchsucht und alle Excel Dateien deren werte auflistet.

Jetzt ist es so, da jeden Tag eine neue Datei dazukommt, bricht jetzt die VBA Script ab. (ggf. jetzt einfach zu viel zum kopieren oä.)
Vermute ich.

Das ist der Entstandene Code dafür.

Code:
Sub Lese()

Dim intBereich As Integer

Dim intZeile As Integer

Dim intSpalte As Integer

Dim strDatei As String

Dim intAnzVerz  As Integer

Dim intAktVerz  As Integer

Dim intAktBlatt As Integer

Dim intAktZeile As Integer

Dim intAktSpalte As Integer

Dim intSpDatum As Integer

Dim intSpBlatt As Integer

Dim intSpDatei As Integer

Dim intSpVerz As Integer

Dim strVerz As String

Dim strVerzA() As String

Dim varDatum As Variant

Dim varKopie As Variant

Dim varRngKopie As Variant

Dim bolLeer As Boolean

Dim rngAusgabe As Range

Dim wbLesen As Workbook

Dim wsLesen As Worksheet

Const intMaxVerz As Integer = 30

Const intMaxblatt As Integer = 2

Const strTeilDatei As String = ".xlsx"

Const strRngDatum As String = "C2"

Const strRngKopie As String = "B3:J55"

Const bolZeigVerz As Boolean = False

Const bolZeigDatei As Boolean = False

Const bolZeigBlatt As Boolean = False

Const bolZeigLeer As Boolean = True

Application.ScreenUpdating = False

'----------------------------------------------------

' Spalten für Verzeichnis, Datei und Blatt einrichten

'----------------------------------------------------

intSpDatum = 0

intSpBlatt = 0

intSpDatei = 0

intSpVerz = 0

If bolZeigBlatt Then

    intSpDatum = intSpDatum + 1

End If

If bolZeigDatei Then

    intSpDatum = intSpDatum + 1

    intSpBlatt = intSpBlatt + 1

End If

If bolZeigVerz Then

    intSpDatum = intSpDatum + 1

    intSpBlatt = intSpBlatt + 1

    intSpDatei = intSpDatei + 1

End If

varRngKopie = Split(strRngKopie)

'----------------------------------------------------

' Verzeichniseinlesen und Variablen initialisieren

'----------------------------------------------------

ReDim strVerzA(intMaxVerz)

intAktVerz = 1

intAnzVerz = 1

intAktZeile = 0

strVerzA(intAnzVerz) = ThisWorkbook.Names("Verzeichnis").RefersToRange

Set rngAusgabe = ThisWorkbook.Worksheets("Füllung").Cells(3, 1)

'Set rngAusgabe = ThisWorkbook.Names("Ausfüllen").RefersToRange

'----------------------------------------------------

' Schleife über Verzeichnisse

'----------------------------------------------------

While intAktVerz <= intAktVerz And intAktVerz <= intMaxVerz

    strVerz = strVerzA(intAktVerz)

    strDatei = Dir(strVerz, vbDirectory)

'----------------------------------------------------

' Schleife über Dateien im Verzeichnis

'----------------------------------------------------

    While strDatei <> ""

        If (GetAttr(strVerz & strDatei) And vbDirectory) = vbDirectory Then

            If strDatei <> "." And strDatei <> ".." And strDatei <> "" And intAnzVerz < intMaxVerz Then

                intAnzVerz = intAnzVerz + 1

                strVerzA(intAnzVerz) = strVerz & strDatei & "\"

            End If

        Else

            If InStr(strDatei, strTeilDatei) > 0 And strDatei <> ThisWorkbook.Name Then

                intAktBlatt = 0

                Set wbLesen = Workbooks.Open(Filename:=strVerz & strDatei, ReadOnly:=True)

                For Each wsLesen In wbLesen.Worksheets

                    intAktBlatt = intAktBlatt + 1

                    If intAktBlatt <= intMaxblatt Then

                        varDatum = wsLesen.Range(strRngDatum)

                        For intBereich = 0 To UBound(varRngKopie)

                            varKopie = wsLesen.Range(varRngKopie(intBereich)).Value

                            For intZeile = 1 To UBound(varKopie, 1)

'----------------------------------------------------

' Prüfen ob Werte leer

'----------------------------------------------------

                                If bolZeigLeer Then

                                    bolLeer = False

                                Else

                                    bolLeer = True

                                    For intSpalte = 1 To UBound(varKopie, 2)

                                        If varKopie(intZeile, intSpalte) <> "" Then

                                            bolLeer = False

                                        End If

                                    Next intSpalte

                                End If

'----------------------------------------------------

' Schreiben wenn nicht leer

'----------------------------------------------------

                                If Not bolLeer Then

                                    For intSpalte = 1 To UBound(varKopie, 2)

                                        rngAusgabe.Offset(intAktZeile, intSpalte + intSpDatum).Value = varKopie(intZeile, intSpalte)

                                    Next intSpalte

                                    rngAusgabe.Offset(intAktZeile, intSpVerz).Value = strVerz

                                    rngAusgabe.Offset(intAktZeile, intSpDatei).Value = strDatei

                                    rngAusgabe.Offset(intAktZeile, intSpBlatt).Value = wsLesen.Name

                                    rngAusgabe.Offset(intAktZeile, intSpDatum).Value = varDatum

                                    intAktZeile = intAktZeile + 1

                                End If

                            Next intZeile

                        Next intBereich

                    End If

                Next wsLesen

                wbLesen.Close savechanges:=False

            End If

        End If

    strDatei = Dir()

    Wend

    intAktVerz = intAktVerz + 1

Wend

Application.ScreenUpdating = True

End Sub

Jetzt habe ich mir überlegt, da ich mit dem abrufen Probleme habe, jedes Jahr einen neuen Ordner anzulegen und dann nur noch nach Jahr abzurufen.

Wenn dann abgerufen ist, alle Daten zusammenführen.

Kann man das irgendwie sinnvoll lösen?

Hat jemand Tipps?

Die Daten müssten bei der Zusammenführung kontrolliert und ersetzt bzw. das was noch nicht vorhanden ist angefügt werden.

Ich hoffe ihr könnt mir helfen.

Viele liebe Grüße und schon mal vielen Dank vorab

Hi,

importierst Du echt jeden Tag alle vorhergehenden und die eine neue Datei? Ist das sinnvoll?

Du könntest doch alle importierten Dateien nach dem Import in ein Archiv-Verzeichnis verschieben lassen und dann nur noch die eine neue Datei importieren, das ist auch insgesamt viel schneller.

Zu aufwändige Code für eine einfache Aufgabe.

Hallo Ralf,

aktuell ja. Das ist eine gute Idee. Wie könnte ich das so anpassen, dass das klappt??

SNB was empfiehlst du denn?
Ich kann es leider nicht gut genug um es zu vereinfachen bzw um es stabiler zu machen.

Danke und lieben Gruß

Hallo, hat keiner einen Tip?

Lieben Gruß

Hallöchen,

hast Du denn den Tipp von Ralf mal ausprobiert?

Per Code könntest Du das im Prinzip so umsetzen:

Code:
Dim FSO as FileSystemObject 

FSO.MoveFile OldPath & OldName, NewPath & OldName

Du müsstest noch einen Verweis auf das Windows Scripting setzen.

Eine einfache Alternative wäre auch das Umbenennen:

Code:
Name OldName As NewName

Wenn Du da aus der Exceldatei eine Excel.Sik machst

Code:
Name OldName As OldName & ".sik"

werden die eventuell auch nicht mehr eingelesen.

tw3aker

Rabe

snb

tw3aker

tw3aker

schauan