PDA

Vollständige Version anzeigen : Prüfen, ob Excel-Datei bereits geöffnet


HotDog
20.07.2001, 17:28
Hallo,
wer kann mir helfen?
Beim Importieren einer Excel-Tabelle möchte ich vorher prüfen, ob die Excel-Tabelle bereits geöffnet ist.
Wie lautet hierzu der VBA-Code.
Vielen Dank für eure Hilfe.

mfg

TOM

Stefan Kulpa
21.07.2001, 07:24
<font face="Verdana" size="2">Hallo,

diese Überprüfung ist gar nicht so einfach. Eine mögliche Lösung kann über das Win32-API realisiert werden; nachfolgend der entsprechende Code.
Nutzung: Kopiere das Listing in ein Modul und rufe die Funktion FileInUse() analog dem Beispiel "Sub Test()" auf.</font>

<PRE><FONT SIZE=1 FACE=Courier New><FONT COLOR=#000080>Option</FONT> <FONT COLOR=#000080>Explicit</FONT>

<FONT COLOR=#000080>Private</FONT> <FONT COLOR=#000080>Const</FONT> GENERIC_READ <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT> = &H80000000
<FONT COLOR=#000080>Private</FONT> <FONT COLOR=#000080>Const</FONT> OPEN_EXISTING <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT> = 3
<FONT COLOR=#000080>Private</FONT> <FONT COLOR=#000080>Const</FONT> FILE_ATTRIBUTE_NORMAL <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT> = &H80
<FONT COLOR=#000080>Private</FONT> <FONT COLOR=#000080>Const</FONT> INVALID_HANDLE_VALUE <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT> = -1
<FONT COLOR=#000080>Private</FONT> <FONT COLOR=#000080>Const</FONT> ERROR_SHARING_VIOLATION <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT> = &H20
<FONT COLOR=#000080>Private</FONT> <FONT COLOR=#000080>Const</FONT> FORMAT_MESSAGE_FROM_SYSTEM <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT> = &H1000

<FONT COLOR=#000080>Private</FONT> <FONT COLOR=#000080>Declare</FONT> <FONT COLOR=#000080>Function</FONT> FormatMessage <FONT COLOR=#000080>Lib</FONT> "kernel32.dll" <FONT COLOR=#000080>Alias</FONT> _
"FormatMessageA" _
(<FONT COLOR=#000080>ByVal</FONT> dwFlags <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>, _
<FONT COLOR=#000080>ByVal</FONT> lpSource <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>, _
<FONT COLOR=#000080>ByVal</FONT> dwMessageId <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>, _
<FONT COLOR=#000080>ByVal</FONT> dwLanguageId <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>, _
<FONT COLOR=#000080>ByVal</FONT> lpBuffer <FONT COLOR=#000080>As String</FONT>, _
nSize <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>, _
Arguments <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>) <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
<FONT COLOR=#000080>Private</FONT> <FONT COLOR=#000080>Declare</FONT> <FONT COLOR=#000080>Function</FONT> CloseHandle <FONT COLOR=#000080>Lib</FONT> "kernel32.dll" _
(<FONT COLOR=#000080>ByVal</FONT> hObject <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>) <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
<FONT COLOR=#000080>Private</FONT> <FONT COLOR=#000080>Declare</FONT> <FONT COLOR=#000080>Function</FONT> CreateFile <FONT COLOR=#000080>Lib</FONT> "kernel32.dll" <FONT COLOR=#000080>Alias</FONT> _
"CreateFileA" _
(<FONT COLOR=#000080>ByVal</FONT> lpFileName <FONT COLOR=#000080>As String</FONT>, _
<FONT COLOR=#000080>ByVal</FONT> dwDesiredAccess <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>, _
<FONT COLOR=#000080>ByVal</FONT> dwShareMode <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>, _
<FONT COLOR=#000080>ByVal</FONT> lpSecurityAttributes <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>, _
<FONT COLOR=#000080>ByVal</FONT> dwCreationDisposition <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>, _
<FONT COLOR=#000080>ByVal</FONT> dwFlagsAndAttributes <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>, _
<FONT COLOR=#000080>ByVal</FONT> hTemplateFile <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>) <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT>
<FONT COLOR=#808080><HR></FONT>

<FONT COLOR=#000080>Public</FONT> <FONT COLOR=#000080>Sub</FONT> Test()

<FONT COLOR=#000080>Dim</FONT> sErrMsg <FONT COLOR=#000080>As String</FONT>
<FONT COLOR=#000080>Dim</FONT> sFilename <FONT COLOR=#000080>As String</FONT>

sFilename = "C:\Temp\MyFile.xls"
<FONT COLOR=#000080>If</FONT> FileInUse(sFilename, sErrMsg) <FONT COLOR=#000080>Then</FONT>
<FONT COLOR=#008000>'** Datei wird benutzt</FONT>
<FONT COLOR=#000080>If</FONT> Len(sErrMsg) > 0 <FONT COLOR=#000080>Then</FONT>
<FONT COLOR=#008000>'** Kam es zu einem Fehler?</FONT>
MsgBox sErrMsg, vbExclamation, "Fehler beim Dateizugriff"
<FONT COLOR=#000080>Else</FONT>
<FONT COLOR=#008000>'** Kein Fehler, Datei ist lediglich geöffnet!</FONT>
MsgBox "Datei wird z.Zt. benutzt!", vbExclamation, "Achtung"
<FONT COLOR=#000080>End</FONT> <FONT COLOR=#000080>If</FONT>
<FONT COLOR=#000080>Else</FONT>
<FONT COLOR=#000080>If</FONT> Len(sErrMsg) > 0 <FONT COLOR=#000080>Then</FONT>
<FONT COLOR=#008000>'** Es kam zu einem Zugriffsfehler</FONT>
MsgBox sErrMsg, vbExclamation, "Fehler beim Dateizugriff"
<FONT COLOR=#000080>Else</FONT>
<FONT COLOR=#008000>'** Alles ok, die Datei existiert und ist nicht geöffnet!</FONT>
MsgBox "Datei wird nicht benutzt!", vbInformation, "Hinweis"
<FONT COLOR=#000080>End</FONT> <FONT COLOR=#000080>If</FONT>
<FONT COLOR=#000080>End</FONT> <FONT COLOR=#000080>If</FONT>

<FONT COLOR=#000080>End</FONT> <FONT COLOR=#000080>Sub</FONT>
<FONT COLOR=#808080><HR></FONT>

<FONT COLOR=#000080>Public</FONT> <FONT COLOR=#000080>Function</FONT> FileInUse(<FONT COLOR=#000080>ByVal</FONT> sFilename <FONT COLOR=#000080>As String</FONT>, _
<FONT COLOR=#000080>Optional</FONT> <FONT COLOR=#000080>ByRef</FONT> sErrorMsg <FONT COLOR=#000080>As String</FONT> = vbNullString) <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Boolean</FONT>
<FONT COLOR=#008000>'// ============================================================================</FONT>
<FONT COLOR=#008000>'// Funktion: |Ermittelt, ob eine Datei z.Zt. geöffnet ist.</FONT>
<FONT COLOR=#008000>'// ----------------------------------------------------------------------------</FONT>
<FONT COLOR=#008000>'// Voraussetzungen: |-</FONT>
<FONT COLOR=#008000>'// ----------------------------------------------------------------------------</FONT>
<FONT COLOR=#008000>'// Parameter: |sFilename = gültiger Dateipfad</FONT>
<FONT COLOR=#008000>'// |sErrorMsg = (optional) Rückgabestring mit Fehlerdetails</FONT>
<FONT COLOR=#008000>'// ----------------------------------------------------------------------------</FONT>
<FONT COLOR=#008000>'// Rückgabe: |True bei Zugriffsverletzung (= geöffnete Datei)</FONT>
<FONT COLOR=#008000>'// ----------------------------------------------------------------------------</FONT>
<FONT COLOR=#008000>'// Erstellt: |21.07.2001; Stefan Kulpa</FONT>
<FONT COLOR=#008000>'// ----------------------------------------------------------------------------</FONT>
<FONT COLOR=#008000>'// Geändert: |</FONT>
<FONT COLOR=#008000>'// |</FONT>
<FONT COLOR=#008000>'// ============================================================================</FONT>
<FONT COLOR=#000080>Dim</FONT> lFile <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT> <FONT COLOR=#008000>'** Datei-Handle</FONT>
<FONT COLOR=#000080>Dim</FONT> lError <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT> <FONT COLOR=#008000>'** Fehler-Code</FONT>
<FONT COLOR=#000080>Dim</FONT> lResult <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT> <FONT COLOR=#008000>'** API-Rückgabewert</FONT>
<FONT COLOR=#000080>Dim</FONT> lBufLen <FONT COLOR=#000080>As</FONT> <FONT COLOR=#000080>Long</FONT> <FONT COLOR=#008000>'** API-String-Buffer-Länge</FONT>
<FONT COLOR=#000080>Dim</FONT> sBuffer <FONT COLOR=#000080>As String</FONT> <FONT COLOR=#008000>'** API-String-Buffer</FONT>
<FONT COLOR=#008000>'** Fehlerhandling einrichten</FONT>
<FONT COLOR=#000080>On Error GoTo</FONT> Err_FileInUse
<FONT COLOR=#008000>'** Versuchen, Datei zu öffnen</FONT>
lFile = CreateFile(sFilename, _
GENERIC_READ, _
0, _
0, _
OPEN_EXISTING, _
FILE_ATTRIBUTE_NORMAL, _
0)
<FONT COLOR=#008000>'** Prüfen, ob ein gültiges Datei-Handle erzeugt wurde</FONT>
<FONT COLOR=#000080>If</FONT> lFile = INVALID_HANDLE_VALUE <FONT COLOR=#000080>Then</FONT>
<FONT COLOR=#008000>'** Fehler-Code ermitteln</FONT>
lError = Err.LastDllError
<FONT COLOR=#008000>'** Liegt eine Zugriffsverletzung vor?</FONT>
<FONT COLOR=#000080>If</FONT> lError = ERROR_SHARING_VIOLATION <FONT COLOR=#000080>Then</FONT>
<FONT COLOR=#008000>'** Status zurückgeben</FONT>
FileInUse = <FONT COLOR=#000080>True</FONT>
<FONT COLOR=#000080>Else</FONT>
<FONT COLOR=#008000>'** Alle anderen Fehler formatiert zurückgeben</FONT>
sBuffer = String(256, 0)
lResult = _
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, _
0, _
lError, _
0, _
sBuffer, _
Len(sBuffer), _
0)
<FONT COLOR=#008000>'** Fehlerbeschreibung aufbereiten</FONT>
<FONT COLOR=#000080>If</FONT> lResult > 0 <FONT COLOR=#000080>Then</FONT>
sErrorMsg = Left$(sBuffer, lResult - 1)
<FONT COLOR=#000080>Else</FONT>: sErrorMsg = "Unbekannter Fehler!"
<FONT COLOR=#000080>End</FONT> <FONT COLOR=#000080>If</FONT>
<FONT COLOR=#000080>End</FONT> <FONT COLOR=#000080>If</FONT>
<FONT COLOR=#000080>Else</FONT>
<FONT COLOR=#008000>'** Handle schließen!</FONT>
CloseHandle lFile
<FONT COLOR=#000080>End</FONT> <FONT COLOR=#000080>If</FONT>
Exit_FileInUse:
<FONT COLOR=#008000>'** Fehler-Handling wieder ausschalten</FONT>
<FONT COLOR=#000080>On Error GoTo 0</FONT>
<FONT COLOR=#000080>Exit Function</FONT>

Err_FileInUse:
<FONT COLOR=#008000>'** Handle schließen!</FONT>
<FONT COLOR=#000080>If</FONT> lFile = INVALID_HANDLE_VALUE <FONT COLOR=#000080>Then</FONT> CloseHandle lFile
<FONT COLOR=#000080>If</FONT> Err.Number <> 0 <FONT COLOR=#000080>Then</FONT> sErrorMsg = Err.Description
GoTo Exit_FileInUse <FONT COLOR=#008000>'statt: Resume Exit_FileInUse!</FONT>

<FONT COLOR=#000080>End</FONT> <FONT COLOR=#000080>Function</FONT>

</FONT></PRE>

<font face="Verdana" size="2">HTH</font>