Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1840to1844
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Auflisten aller geöffneten Officeprogram

Auflisten aller geöffneten Officeprogram
03.08.2021 15:53:18
Pepi
Hallo zusammen
kann mir bitte einer sagen, wie ich alle offenen Officeprogramm (evt. alle offenen Programme (nicht Prozesse) auf dem PC auflisten kann.
Auch möchte ich auslesen können wie das aktuelle Programm heisst (Excel, Word, Powerpoint)
Leider habe ich nur alten Code gefunden, der auf 64bit nicht läuft und ich konnte ihn nicht anpassen.
vielen Dank für Eure Unterstützung
mfg
Pepi

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Auflisten aller geöffneten Officeprogram
03.08.2021 16:04:40
Nepumuk
Hallo Pepi,
zeig mal den Code.
Gruß
Nepumuk
AW: Auflisten aller geöffneten Officeprogram
03.08.2021 16:15:25
oraculix
Hallo
Grundsätzlich so

Sub Dateien_ermitteln()
Dim Anzahl As Single, Name As String, i As Byte
Dim Meldung As String
Anzahl = Application.Workbooks.Count
For i = 1 To Anzahl
Name = Application.Workbooks(i).Name
Meldung = Meldung & Name & ", "
Next i
MsgBox Meldung
End Sub
Gruß
Oraculix
AW: Geht völlig an der Anfrage vorbei! (owT)
03.08.2021 16:40:41
EtoPHG

AW: Geht völlig an der Anfrage vorbei! (owT)
03.08.2021 17:35:04
Pepi
Hallo Oraculix
Ich will die Programme wissen nicht die geöffneten Arbeitsmappen
mfg Pepi
Auflisten aller geöffneten Officeprogrammen
03.08.2021 17:47:39
Nepumuk
Hallo Pepi,
so ok?

Option Explicit
Private Declare PtrSafe Function EnumWindows Lib "user32.dll" ( _
ByVal lpEnumFunc As LongPtr, _
ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function GetWindowTextA Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindowTextLengthA Lib "user32.dll" ( _
ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetClassNameA Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongPtrA" ( _
ByVal hwnd As LongPtr, _
ByVal nIndex As Long) As LongPtr
Private Const GWL_STYLE As Long = -16&
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_BORDER As Long = &H800000
Private Const MAX_CLASS_NAME As Long = 255
Private llngRow As Long
Public Sub Start()
llngRow = 1
Columns("A:C").ClearContents
With Range("A1:C1")
.Value = Array("Hwnd", "Klasse", "Caption")
.Font.Bold = True
End With
Call EnumWindows(AddressOf WindowCallBack, ByVal 0)
Columns("A:C").AutoFit
Tabelle1.Sort.SortFields.Clear
Tabelle1.Sort.SortFields.Add Key:=Columns(2)
With Tabelle1.Sort
.SetRange Columns("A:C")
.Header = xlYes
.MatchCase = False
.Apply
End With
End Sub
Private Function WindowCallBack(ByVal pvlngptrHwnd As LongPtr, ByVal lngptrParam As LongPtr) As LongPtr
Dim strCaption As String, strClassName As String
Dim lngReturn As Long
Dim lngptrStyle As LongPtr
lngptrStyle = GetWindowLong(pvlngptrHwnd, GWL_STYLE)
If (lngptrStyle And (WS_VISIBLE Or WS_BORDER)) = (WS_VISIBLE Or WS_BORDER) Then
strClassName = Space$(MAX_CLASS_NAME)
lngReturn = GetClassNameA(pvlngptrHwnd, strClassName, MAX_CLASS_NAME)
strClassName = Left$(strClassName, lngReturn)
lngReturn = GetWindowTextLengthA(pvlngptrHwnd)
strCaption = Space$(lngReturn)
Call GetWindowTextA(pvlngptrHwnd, strCaption, lngReturn + 1)
llngRow = llngRow + 1
Cells(llngRow, 1).Resize(1, 3) = Array(pvlngptrHwnd, strClassName, strCaption)
End If
WindowCallBack = 1
End Function
Gruß
Nepumuk
Anzeige
AW: Auflisten aller geöffneten Officeprogrammen
03.08.2021 18:00:48
Pepi
Hallo Neptun
Das ist ja der absolute Knüller
Es funktioniert mit Win 10, 64bit perfekt
vielen, vielen Dank
Pepi
AW: Sorry
03.08.2021 19:24:38
oraculix
Sorry hab mich verlesen
Gruß
Oraculix
AW: Geht völlig an der Anfrage vorbei! (owT)
03.08.2021 17:44:41
Pepi
Hallo zusammen
Habe hier etwas ähnliches gefunden, das sich ev. für meine Bedürfnisse anpassen lässt.
Leider zeigt dieser Code nur den Win-Explorer an (kein Excel, kein Word)

Sub AppNames()
Dim ShApp As Object, oWindow As Object
Dim App(15) As String
Dim i As Integer
Set ShApp = CreateObject("Shell.Application")
For Each oWindow In ShApp.Windows
i = i + 1
App(i) = oWindow.FullName
cellsl(i,1) = oWindow.FullName
Next oWindow
Set oWindow = Nothing
Set ShApp = Nothing
End Sub
mfg Pepi
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige