Tipp 0396 Arbeitsmappe bereits in Excel geöffnet?
Autor/Einsender:
Datum:
  R. Müller / Angie
29.04.2004
Entwicklungsumgebung:   Excel 2000
In Excel ist es nicht möglich, gleichzeitig zwei Arbeitsmappen mit dem selben Namen zu öffnen, selbst wenn sich diese in verschiedene Ordnern befinden. Daher ist eine Überprüfung, ob eine Arbeitsmappe mit diesem Namen bereits geöffnet ist, erforderlich. Hier wird auch überprüft, ob der Zugriff auf die Arbeitsmappe überhaupt möglich ist, wenn ja, so wird die Arbeitsmappe geöffnet und/oder aktiviert.
Code im Codebereich des Moduls
 
Option Explicit

Public Function GetWorkbook(ByVal vsWkbPath As String, _
      ByVal vsWkbName As String) As Workbook

  Dim intNameLen    As Integer
  Dim strMsg        As String

  Dim strFileName   As String
  Dim FN            As Integer

  On Error Resume Next
  intNameLen = _
        Len(ThisWorkbook.Application.Workbooks(vsWkbName).Name)
  On Error GoTo 0

  If intNameLen <> 0 Then
    If UCase$(Application.Workbooks(vsWkbName).Path) = _
          UCase$(vsWkbPath) Then
      Set GetWorkbook = Application.Workbooks(vsWkbName)

    Else
      strMsg = "Eine Datei mit dem Namen '" & vsWkbName & "' "
      strMsg = strMsg & "ist bereits geöffnet. Es können keine "
      strMsg = strMsg & "zwei Dateien mit dem selben Namen "
      strMsg = strMsg & "geöffnet werden, selbst wenn sich die "
      strMsg = strMsg & "Dateien in unterschiedlichen Ordner "
      strMsg = strMsg & "befinden." & vbCrLf
      strMsg = strMsg & "Schließen Sie entweder die erste Datei "
      strMsg = strMsg & "um die zweite zu öffnen, oder benennen "
      strMsg = strMsg & "Sie eine der Dateien um."

      MsgBox strMsg, vbOKOnly + vbExclamation
    End If

  Else
    If Not Right(vsWkbPath, 1) = "\" Then _
          vsWkbPath = vsWkbPath & "\"
    strFileName = vsWkbPath & vsWkbName

    If Len(Dir$(strFileName, vbNormal)) = 0 Then
      strMsg = "'" & strFileName & "' wurde nicht gefunden. "
      strMsg = strMsg & "Überprüfen Sie die Rechtschreibung "
      strMsg = strMsg & "des Dateinamens und überprüfen Sie, "
      strMsg = strMsg & "ob der Ort der Datei korrekt ist."

      MsgBox strMsg, vbOKOnly + vbExclamation

    Else
      FN = FreeFile()

      On Error Resume Next
      Err.Clear
      Open strFileName For Random Access Read _
            Lock Read Write As #FN
      Close #FN

      Select Case Err.Number
        Case 0
          Set GetWorkbook = Application.Workbooks.Open(strFileName)

        Case Else
          MsgBox "Fehler-Nr. " & Err.Number & vbCrLf & _
                Err.Description, vbOKOnly + vbExclamation, "Fehler"
      End Select
      On Error GoTo 0
    End If
  End If
End Function
 
Beispiel-Aufruf
 
Dim strWkbPath As String
Dim strWkbName As String

Dim objWkb As Workbook

strWkbPath = "c:\temp"
strWkbName = "Mappe1.xls"

Set objWkb = GetWorkbook(strWkbPath, strWkbName)
If objWkb Is Nothing Then Exit Sub
objWkb.Activate

Set objWkb = Nothing
 
Hinweis
Die im Download befindliche *.bas-Datei kann in Excel im VB-Editor importiert werden.

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
Excel-Version
95
97
2000
2002 (XP)
2003
2007
2010


Download  (2,5 kB) Downloads bisher: [ 978 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Samstag, 3. September 2011