|
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
|
|
|
|
|
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
|
|
|
|
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: [ 988 ]
|
|
|