prüfen ob Word-Datei bereits geöffnet ist

[FrankyHB]

Hallo zusammen,

ich brauch mal wieder Hilfe.

ich möchte aus Excel herraus eine Word-Datei öffenen. Das klappt soweit auch ganz gut.

Ich möchte jedoch erreichen, dass beim erneuten drücken des Boutons die selbe Datei nicht nochmal geöffnet wird.

Excel soll also prüfen ob die Datei bereits geöffnet ist und wen Ja, den Vorgang abbrechen.

Ich habe das mit folgendem Code versucht:


Dim objWordApp As Object
Dim appWord As Object
   
On Error Resume Next

Set objWordApp = CreateObject("Word.Application")
Set appWord = Application

objWordApp.Application.Visible = True
objWordApp.Application.Documents.Open ("C:\Module\Test.docx")
objWordApp.Activate


err:
If err.Number <> 0 Then
       MsgBox ("Dokument war schon geöffnet !")
End If

Set appWord = Nothing
Set objWordApp = Nothing

End Sub


Leider öffnet Excel dennoch Word und bietet ein schreibgeschütztes Dokument an .

Kann mir jemand weiterhelfen?

Gruss Frank

[Steffl]

Hallo Frank,

hilft dir das https://www.online-excel.de/excel/singsel_vba.php?f=43 weiter?

[Warkings]

CP: https://www.ms-office-forum.net/forum/sh...p?t=370568

[volti]

Hallo Frank,

mit folgendem Code kannst Du eine Worddatei öffnen und wenn sie schon offen ist, wird sie nicht erneut geöffnet.

Da die Datei auch geöffnet wird, wenn sie noch nicht offen ist, kann man m.E. auf den Part mit "CreateObject" verzichten.

Schau mal, ob es das Richtige für Dich ist:

Code:

Sub WordOeffnen()
 Dim objWordApp As Object
 Dim objDoc As Object
 Dim sDatei As String
  
 sDatei = "C:\Module\Test.docx"

 If Dir(sDatei) <> "" Then
  Set objDoc = CreateObject(sDatei, vbNullString) 'Datei öffnen
  Set objWordApp = objDoc.Parent                  'Application ermitteln
 
  objWordApp.Visible = True                       'Word sichtbar machen
  objWordApp.Activate                             'und aktivieren

'Weitere Aktionen....

  Set objDoc = Nothing
  Set objWordApp = Nothing
 
 Else
  MsgBox "Datei ist nicht vorhanden!", vbCritical, "Worddatei öffnen"
 
 End If
End Sub

____________________
viele Grüße aus Freigericht
Karl-Heinz

[FrankyHB]

Hallo Karl-Heinz,

vielen vielen Dank - genau das habe ich gesucht.

Herzlichen Dank
Frank

[FrankyHB]

Hallo Karl-Heinz,

Alles läuft soweit gut, es gibt nur ein kleines Problem:

wenn ich den Code im VBA Editor eintrage läuft alles wie gewünscht - zwar wird die MsgBox nicht ausgelöst wenn ich das Word Dokument ein zweitesmal öffne, es wird aber auch kein neues Dokument geöffnet - so wie gewünscht.

Wenn ich danach Excel beende und dann wieder neu öffne, erscheint das Word Dokument nur minimiert in der Taskleiste.

Wie kann ich das ändern wenn ich das Fenster maximiert geöffnet bekommen möchte.

Ich habe schon alle möglichen Befehle ausprobiert - leider ohne Erfolg.

Gruß Frank

[FrankyHB]

Hallo Karl-Heinz,

Alles läuft soweit gut, es gibt nur ein kleines Problem:

wenn ich den Code im VBA Editor eintrage läuft alles wie gewünscht - zwar wird die MsgBox nicht ausgelöst wenn ich das Word Dokument ein zweitesmal öffne, es wird aber auch kein neues Dokument geöffnet - so wie gewünscht.

Wenn ich danach Excel beende und dann wieder neu öffne, erscheint das Word Dokument nur minimiert in der Taskleiste.

Wie kann ich das ändern wenn ich das Fenster maximiert geöffnet bekommen möchte.

Ich habe schon alle möglichen Befehle ausprobiert - leider ohne Erfolg.

Gruß Frank

[schauan]

Hallöchen,

ich würde noch ein paar andere Schritte nehmen.
Zuerst mal könntest Du prüfen, ob Word geöffnet ist und sich in der Dateiauflistung die gesuchte befindet, ähnlich wie man das auch in Excel tun würde.

Hier mal das Grobgerüst

Code:

Set objWord = GetObject(, "Word.Application")
If Not objWord Is Nothing Then
    For Each docs In objWord.Documents
      '... Dateinamen pruefen. Wenn Datei in Liste, dann Variable auf True setzen. z.B. boOpen = True
    Next
Else
    'hier CreateObject
End If
If boOpen = False Then 'Datei oeffnen

[FrankyHB]

Hallo André,

vielen Dank für die Hilfe aber irgendwie funktioniert das so nicht - könnst du evtl. den kompletten Code aufschreiben ?!

Danke und schöne Grüsse Frank

[schauan]

Hallöchen,

hier ist er, auf Basis von Karl-Heinz' Code

Code:

Option Explicit

Sub WordOeffnen()
Dim objWordApp As Object
Dim objDoc As Object
Dim sDatei As String
Dim boOpen As Boolean

sDatei = "C:\Test\Test.docx"

If Dir(sDatei) <> "" Then
  On Error Resume Next
    Set objWordApp = GetObject(, "Word.Application")
  On Error GoTo 0
  If Not objWordApp Is Nothing Then
    For Each objDoc In objWordApp.documents
      '... Dateinamen pruefen. Wenn Datei in Liste, dann Variable auf True setzen. z.B. boOpen = True
      If objDoc.Name = Right(sDatei, InStr(1, StrReverse(sDatei), "\") - 1) Then boOpen = True
    Next
  Else
    Set objWordApp = CreateObject("Word.Application")
  End If
  
  objWordApp.Visible = True                       'Word sichtbar machen
  objWordApp.Activate                             'und aktivieren
  
  If boOpen = False Then objWordApp.documents.Open sDatei
  'oder ... Set objDoc = objWordApp.documents.Open sDatei
  
  'Weitere Aktionen....
  
  Set objDoc = Nothing
  Set objWordApp = Nothing
  
Else
  MsgBox "Datei ist nicht vorhanden!", vbCritical, "Worddatei öffnen"
End If
End Sub