Auslesen der geöffneten Datei

Private Sub Daten_holen()

    

    Dim Jahr As String

    Dim i As Integer

    Dim found As Boolean

    Dim noFilesFound As Boolean

    Dim wb As Workbook

    Dim ws As Worksheet

    Dim Ausgabe As String

    Dim Eingabe As String

    Dim Zeichen As String

    Dim filePath As Variant

    Dim isOpen As Boolean

    

    ' Deaktiviere ScreenUpdating und PopUps (Bildschirmflackern)

    Application.ScreenUpdating = False

    Application.DisplayAlerts = False

    

    ' Umwandlung der Nummer auf lesbares Format

    Eingabe = Tabelle1.Range("B12").value ' entspricht der Zelle mit der Nummer

    Ausgabe = "" ' soll erstmal leer sein

    

    ' hier wird die Nummer dem Format des Nummer-Ordners im Explorer angepasst

    ' alle nicht nummerischen Zeichen (auch Leerzeichen) werden entfernt

    ' durchlaufe jeden Buchstaben in der Eingabe

    For i = 1 To Len(Eingabe)

        Zeichen = Mid(Eingabe, i, 1)

        ' überprüfe, ob das Zeichen eine Ziffer ist

        If IsNumeric(Zeichen) Then

            ' füge die Ziffer zur Ausgabe hinzu

            Ausgabe = Ausgabe & Zeichen

        End If

    Next i

    

    ' Ausgabezelle

    Tabelle1.Range("B14").value = Ausgabe

                       

    ' Öffnen des Dialogfensters zum Auswählen der Dateien

    With Application.FileDialog(msoFileDialogOpen)

    

        .InitialFileName = "D:dokumenteOrdner" & Ausgabe & "dokumente"

        .Filters.Clear

        .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls"

        

        ' Mehrfachauswahl wurde eingestellt

        .AllowMultiSelect = True

        

        If .Show = True Then

            

            For Each filePath In .SelectedItems

                

                ' Überprüfen, ob die ausgewählte Datei bereits geöffnet ist

                isOpen = False

                For Each wb In Workbooks

                    If wb.FullName = filePath Then

                        Set ws = wb.Sheets(1)

                        isOpen = True

                        Exit For

                    End If

                Next wb

                

                If Not isOpen Then

                    ' Wenn die Datei nicht bereits geöffnet ist, versuchen Sie zu öffnen

                    Set wb = Workbooks.Open(filePath, UpdateLinks:=False, ReadOnly:=True)

                    Set ws = wb.Sheets(1)

                End If

                

                ' Prüfen, ob es sich bei der geöffneten Datei um die richtige Datei handelt

                If ws.Range("A2").value = "Berechnung der Werte" Then

                    

                    ' Prüfen, ob in den Labels vierstellige Jahre stehen

                    For i = 1 To 5

                        Jahr = Me.Controls("Label" & i).Caption

                        If Len(Jahr) > 4 Or Not IsNumeric(Jahr) Then

                            MsgBox "Fehler: Das Jahr in Label " & i & " ist nicht vierstellig oder keine Zahl."

                            wb.Close SaveChanges:=False

                            Exit Sub

                        End If

                    Next i

                    

                    ' Function: Daten auslesen und importieren

                    Importiere_Datei ws

                    

                    ' Schließe die Arbeitsmappe ohne speichern

                    wb.Close SaveChanges:=False

                    

                Else

                    

                    ' sollte die falsche Excel-Datei ausgewählt worden sein, kommt hier die Info

                    MsgBox "Diese oder eine geöffnete Excel-Datei entspricht nicht den Vorgaben"

                    wb.Close SaveChanges:=False

                    

                End If

                

            Next filePath

            

         Else

            Exit Sub

            

        End If

        

    End With

    

    ' Aktiviere ScreenUpdating und PopUps (Bildschirmflackern)

    Application.ScreenUpdating = true

    Application.DisplayAlerts = true

    

End Sub