Überprüfung ob Datei bereits geöffnet
22.05.2016 19:20:07
Robert
ich habe ein größeres Makro geschrieben welches in der Lage ist, eine Quelldatei mit meiner Zieldatei zu vergleichen und im positiven Fall Zahlenwerte zu kopieren. Ich habe jetzt eine Schutzfunktion eingepflegt, falls der Anwender auf den Trichter kommt eine Datei einzulesen die bereits im Hintergrund geöffnet wurde.
Trifft dies zu, kommt auch wie gewünscht meine Fehlermeldung und das Makro schließt sich. Jetzt das Problem: Man schließt die entsprechende Quelldatei manuell, öffnet das Makro wieder und versucht selbige einzulesen, und es kommt zum Runtime-Error (es ist übrigens egal welche Datei man jetzt einliest, es kommt immer ein Fehler, man könnte auch eine leere Mappe einlesen)
Leider ist das Makro zu groß um es hier im Ganzen darzustellen. Es geht speziell um den Anfangsbereich ich habe daher unnütze Funktionen entfernt zur Vereinfachung.
Ich habe die problematische Zeile mit "Absturz" markiert. Hat jemand eine Idee für mich ?
Dim datei_quelle As Variant
Dim i, r, o, gefunden, probenr, nichtgefunden, ueberschreitung, letztezeileZ, letztezeileq, letztespalte As Integer
Dim myDocument As Object
Dim version, CasZ, CasQ, dateiname, leerezeilen, analyse_offen As String
Dim analytik_offen As String
Dim strBla As String
Option Explicit
'---Funktion zur Überprüfung ob Workbook bereits offen------------------------------------------ _ -----------------------------------
Function IsWorkbookOpen(strWB As String) As Boolean
On Error Resume Next
IsWorkbookOpen = Not Workbooks(strWB) Is Nothing
End Function
Sub NOW_Makro()
'---Damit Änderungen an der NOW-Tabelle nicht verloren gehen Mappe speichern
ActiveWorkbook.Save
'---Variablen setzen
gefunden = 0
nichtgefunden = 0
version = "NOW Analytik 0.6"
MsgBox "Bitte die zu untersuchende Analytik auswählen!" & vbNewLine & vbNewLine & "Die fertige _
_
Analyse wird im selben Verzeichnis wie die Analytik gespeichert!", vbInformation, version
'---Zieldatei öffnen und kopieren--------------------------------------------------------------- _
_
Dim QWB As Workbook
'---Quelle, aus der die Tabelle kopiert werden soll
datei_quelle = Application.GetOpenFilename("Excel-Dateien(*.xl*),*.xl*")
If datei_quelle = False Then Exit Sub
'---Analyse schon geöffnet im Hintergrund? Überprüfen!
analyse_offen = Right(datei_quelle, Len(datei_quelle) - InStrRev(datei_quelle, "\"))
If IsWorkbookOpen(analyse_offen) Then
MsgBox "Analytik im Hintergrund bereits geöffnet!" & vbNewLine & "Bitte schließen und _
Analyse erneut starten!", vbExclamation, version
ActiveWorkbook.Close
End If
Set QWB = Workbooks.Open(Filename:=datei_quelle, ReadOnly:=True)
'---Inhalt in Ziel-Tabelle einfügen
ABSTURZ an dieser Stelle
QWB.Worksheets(1).Cells.copy Workbooks(1).Worksheets(2).Cells(1, 1)
'---Quelldatei schließen
QWB.Close
End Sub