ich bräuchte mal eure Hilfe.
Mein Code soll eine Datei öffnen, auslesen und wieder schließen. Das funktioniert erstmal ganz gut.
Wenn aber die Datei schon geöffnet ist, funktioniert das nicht.
Kann mir jemand helfen den Fehler zu finden?
Danke
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