Handling Anweisung Explorer Fenster (VBA)

If CATIAApp Is Nothing Then Set CATIAApp = CreateObject("CATIA.Application") End If ' Aktives Dokument auswählen Set selection = CATIAApp.ActiveDocument.selection 'Automatic Offset ausführen CATIAApp.StartCommand "Offset" Sleep 500 OffsetSave = FindWindow("#32770", "Offset") While OffsetSaveButton = 0 OffsetSaveButton = FindWindowEx(OffsetSave, 0, "Button", "Save") Wend SendMessage OffsetSaveButton, BM_CLICK, 0, 0 Sleep 1000 'hier soll im Explorere Fenster die Datei als .model abgespeichert werden

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Betsy,

hier eine erste Idee als Anregung zu Deinem Anliegen, die Speichern-Dialogbox mit einem Dateinamen zu versehen und den Speichenbutton zu klicken.

Es wird angenommen, dass es sich um eine externe Dialogbox handelt, so dass Excel in einer Schleife bis zum Erscheinung der DlgBox im Vordergrund weiterläuft.
PS: Dialogboxen, die von Excel selbst aufgerufen werden und wo der Code bis zu deren Schließung nicht weiterläuft, müssen anders behandelt werden. (z.B. Timer)

Ich habe mich für eine mittlere und nicht zu umfangreiche Technik entschieden, bei der zur Sicherheit neben dem Fenstertext auch die Klasse abgefragt wird und bei der nach 20 erfolglosen Sekunden ein Abbruch stattfindet.
Auf FindWindow und FindwindowEx habe ich verzichtet, statt dessen kannst Du mehrere Fenstertexte incl. * vorgeben, so dass deutsch und englisch funktionieren würde.

Leider bekomme ich mit GetDlgItem kein Handle für die Editbox, SetDlgItemText funktioniert auch nicht (weiß der Geier warum), so dass ich auf Enumerierung der Childwindows umgestiegen bin.
Mehr Code und komplizierter, funktioniert dafür aber. :-)

Testen konnte ich nur kurz mit dem Editor. Ob es bei Dir klappt, weiß ich natürlich nicht, sollte es aber.

BTW: Du musst sicherstellen, dass es die zu speichernde Datei nicht schon gibt, sonst gibt es Folgedialogboxen ("Datei schon vorhanden") und der Code hängt schon wieder.....
Kann man alles abfangen, aber da wird's dann schon umfangreicher.

Viel Spaß beim Testen.....

Und falls Du noch einen API-Viewer und/oder einen Window-Spy benötigen solltest, hier zwei Ideen dazu:
https://www.clever-excel-forum.de/Thread-API-Viewer
https://www.clever-excel-forum.de/Thread-Windows-Spy-und-Pixelfarben

Option Explicit

Option Compare Text

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr

Private Declare PtrSafe Function GetClassNameA Lib "user32" ( _

        ByVal hwnd As LongPtr, ByVal lpClassName As String, _

        ByVal nMaxCount As Long) As Long

Private Declare PtrSafe Function EnumChildWindows Lib "user32" ( _

        ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, _

        ByVal lParam As LongPtr) As Long

Private Declare PtrSafe Function GetDlgCtrlID Lib "user32" ( _

        ByVal hwnd As LongPtr) As Long

Private Declare PtrSafe Function GetDlgItem Lib "user32" ( _

        ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long) As LongPtr

Private Declare PtrSafe Function SendMessageA Lib "user32" ( _

        ByVal hwnd As LongPtr, ByVal wMsg As Long, _

        ByVal wParam As LongPtr, lParam As Any) As LongPtr

Dim msEditText As String





Sub DialogSpeichernAuto(sDateiname As String)

  Dim sStarttime As Double, hwnd As LongPtr

  

  msEditText = sDateiname                               ' Edittext global

  sStarttime = Timer + 20                               ' Maximal 20 Sek. warten

  Do

     hwnd = GetForegroundWindow                         ' Vordergrundfenster abfragen

     If (GetFenstertext(hwnd) Like "Save*" Or _

         GetFenstertext(hwnd) Like "Speichern*") And _

         GetKlassentext(hwnd) = "#32770" Then           ' Speichern Dialog gefunden

           EnumChildWindows hwnd, AddressOf EnumControls, hwnd

           Sleep 50

' Speichern-Button klcken                    &HF5 = BM_CLICK

           SendMessageA GetDlgItem(hwnd, 1), &HF5, 0, 0 ' ID 1=Speichern, 2=Abbrechen

           Exit Do

     End If

     Sleep 50: DoEvents

     If Timer > sStarttime Then Exit Do                 ' Rausspringer nach Timeout

  Loop

End Sub





' --------- Funktionen Ermittlung Controlparameter -------

Private Function EnumControls(ByVal hChild As LongPtr, ByVal lParam As LongPtr) As Long

' Function ermittelt aus allen Textboxen (Edit) den Text und füllt ein Array

  If GetKlassentext(hChild) Like "Edit" And GetDlgCtrlID(hChild) = 1001 Then

     SendMessageA hChild, &HC, 0, ByVal msEditText      ' &HC = WM_SETTEXT

     EnumControls = False: Exit Function

  End If

  EnumControls = True

End Function



Function GetFenstertext(ByVal hwnd As LongPtr) As String

' Function gibt den Windowtext des gewünschten Fensters zurück

' API GetWindowtext liefert bei Childs oft keine Werte!!!

  Dim sTxt As String * 255

                     

  SendMessageA hwnd, &HD, 255, ByVal sTxt               ' &HD = WM_GETTEXT

  GetFenstertext = Left$(sTxt, InStr(sTxt, vbNullChar) - 1)

End Function



Function GetKlassentext(hwnd As LongPtr) As String

' Function ermittelt die Klasse des Fensters

  Dim sKlasse As String * 32

      

  GetClassNameA hwnd, sKlasse, 32                       ' Klasse des Controls

  GetKlassentext = Left$(sKlasse, InStr(sKlasse, vbNullChar) - 1)

End Function







' ################## Test #######################

Sub Test()

  DialogSpeichernAuto "D:\Meine Testtextdatei.txt"

End Sub

viele Grüße
Karl-Heinz

If CATIAApp Is Nothing Then Set CATIAApp = CreateObject("CATIA.Application") End If 'Dateityp ändern/ auswählen TypSave = FindWindow("#32770", "Save As") TypSaveDropDown = 0 While TypSaveDropDown = 0 TypSaveDropDown = FindWindowEx(TypSave, 0, "?", "?") '???? Wend SendMessage TypSaveDropDown, ? , 0, 0 '???? Sleep 1000 'Datei speichern SpeichernDialog = FindWindow("#32770", "Save As") While SpeichernDialogButton = 0 SpeichernDialogButton = FindWindowEx(SpeichernDialog, 0, "Button", "&Speichern") Wend SendMessage SpeichernDialogButton, BM_CLICK, 0, 0 Sleep 1000

Hi Betsy,

ist mir zwar ein Rätsel, warum Du da nicht weitergekommen bist (bei mir funktioniert es gut), aber nun gut, den Speicher-Button hast Du ja mit der Alternative FindWindowEx auch schon mal bedienen können.

Die DropDown-Buttons haben zwar eine Klasse, aber keine ID und der Text darin aber dürfte ja variieren, so dass Du m.E. so nicht weiterkommst. Nicht umsonst hatte ich ja geschrieben, dass ich die Editbox (verbunden mit den Comboboxen) über EnumChildWindow fülle, da die Handle-Ermittlung mit den üblichen Mitteln fehlschlug.

Anliegend eine Liste zum Speichern-Dialog, vielleicht hilft es Dir ja weiterzukommen. Auch lasse ich die Frage mal offen, da Du noch nicht am Ziel bist.

https://www.herber.de/bbs/user/162223.txt

Viele Grüße
KH

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private Declare PtrSafe Function SendMessageA Lib "user32" ( _ ByVal hWnd As LongPtr, ByVal wMsg As Long, _ ByVal wParam As LongPtr, lParam As Any) As LongPtr Private Declare PtrSafe Function GetDlgCtrlID Lib "user32" ( _ ByVal hWnd As LongPtr) As Long Private Declare PtrSafe Function FindWindowA Lib "user32" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As LongPtr Private Declare PtrSafe Function FindWindowExA Lib "user32" ( _ ByVal hWnd1 As LongPtr, _ ByVal hWnd2 As LongPtr, _ ByVal lpsz1 As String, _ ByVal lpsz2 As String) As LongPtr Private Declare PtrSafe Function GetClassNameA Lib "user32" ( _ ByVal hWnd As LongPtr, ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare PtrSafe Function EnumChildWindows Lib "user32" ( _ ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, _ ByVal lParam As LongPtr) As Long Private Const BM_CLICK As Long = &HF5 Private Const CB_SETCURSEL As Long = &H14E Dim iZaehler As Long Sub Test() Dim hTypSave As LongPtr, hSpeichernDialogButton As LongPtr If CATIAApp Is Nothing Then Set CATIAApp = CreateObject("CATIA.Application") End If ' Dateityp ändern/ auswählen hTypSave = FindWindowA("#32770", "Speichern unter") If hTypSave > 0 Then iZaehler = 0 EnumChildWindows hTypSave, AddressOf EnumControls, 4 ' Welche Position = Dateityp soll ausgewählt werden? ' Datei speichern While hSpeichernDialogButton = 0 hSpeichernDialogButton = FindWindowExA(hTypSave, 0, "Button", "&Speichern") Wend SendMessageA hSpeichernDialogButton, BM_CLICK, 0, 0 End If Sleep 1000 End Sub Private Function EnumControls(ByVal hChild As LongPtr, ByVal lParam As LongPtr) As Long Dim sKlasse As String * 32 GetClassNameA hChild, sKlasse, 32 ' Klasse des Controls If Left$(sKlasse, InStr(sKlasse, vbNullChar) - 1) = "Combobox" Then iZaehler = iZaehler + 1 If iZaehler = 2 Then ' 1=Dateiname 2=Dateityp 3=Codierung SendMessageA hChild, CB_SETCURSEL, lParam, 0 EnumControls = False: Exit Function End If End If EnumControls = True End Function

Beliebteste Forumthreads (12 Monate)

Handling Anweisung Explorer Fenster (VBA)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Handling Anweisung Explorer Fenster (VBA)

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

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread