Fehlermeldung bei bereits geöffneter Datei

varMsgBox = MsgBox("Please select the File_NAME", _ vbOKOnly + vbQuestion, "Selection of actual File") Path = Application.GetOpenFilename If Path = False Then varMsgBox = MsgBox("User Cancelled!", vbOKOnly + vbCritical, "End of Procedure") Exit Sub End If Workbooks.Open Filename:=Path varFile2 = ActiveWorkbook.Name

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Gert,
vor dem Öffnen der ausgewählten Datei muss dann eprüft werden, ob eine Datei mit gleichem Namen bereits geöffnet ist.
Gruß
Franz

Function fncCheckWorkbook(strWorkbookName As String) As Boolean
'Prüft, ob Arbeitsmappe schon geöffnet
Dim wb As Workbook
For Each wb In Workbooks
If LCase(wb.Name) = LCase(strWorkbookName) Then
fncCheckWorkbook = True
Exit For
End If
Next
End Function
Function fncExtractFilename(strName As String) As String
'Trennt das Verzeichnis vom Dateinamen (ab Excel 2000)
If InStr(1, strName, Application.PathSeparator) = 0 Then
fncExtractFilename = strName
Else
fncExtractFilename = Mid(String:=strName, _
Start:=InStrRev(strName, Application.PathSeparator) + 1)
End If
End Function
Sub aatest()
varMsgBox = MsgBox("Please select the File_NAME", _
vbOKOnly + vbQuestion, "Selection of actual File")
Path = Application.GetOpenFilename
If Path = False Then
varMsgBox = MsgBox("User Cancelled!", vbOKOnly + vbCritical, "End of Procedure")
Exit Sub
End If
varfile2 = fncExtractFilename(strName:=Path)
If fncCheckWorkbook(strWorkbookName:=varfile2) = True Then
With Workbooks(varfile2)
If LCase(Path)  LCase(.FullName) Then
'Verzeichnis der geöffneten und der ausgewählten Datei stimmen nicht überein
.Close savechanges:=True
Workbooks.Open Filename:=Path
Else
.Activate
End If
End With
Else
Workbooks.Open Filename:=Path
End If
varfile2 = ActiveWorkbook.Name
End Sub

Sub aatest() varMsgBox = MsgBox("Please select the File_NAME", _ vbOKOnly + vbQuestion, "Selection of actual File") Path = Application.GetOpenFilename If Path = False Then varMsgBox = MsgBox("User Cancelled!", vbOKOnly + vbCritical, "End of Procedure") Exit Sub End If varfile2 = fncExtractFilename(strName:=Path) Application.DisplayAlerts = False If fncCheckWorkbook(strWorkbookName:=varfile2) = True Then With Workbooks(varfile2) If LCase(Path) LCase(.FullName) Then 'Verzeichnis der geöffneten und der ausgewählten Daei stimmen nicht überein .Close savechanges:=True Workbooks.Open Filename:=Path Else .Activate End If End With Else Workbooks.Open Filename:=Path End If If ActiveWorkbook.ReadOnly = True Then MsgBox "The selected file was openend by an other user. Please try later!", _ vbInformation + vbOKOnly, "End of Procedure" ActiveWorkbook.Close savechanges:=False Application.DisplayAlerts = True Exit Sub End If Application.DisplayAlerts = True varfile2 = ActiveWorkbook.Name End Sub

Beliebteste Forumthreads (12 Monate)

Fehlermeldung bei bereits geöffneter Datei

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread