Private Const WM_SETTEXT As Long = &HC&
Private Const WM_CLOSE As Long = &H10&
Private Const HTCAPTION As Long = 2&
' API : retourne le handle d'une sous-fenêtre depuis le handle d'une fenêtre parente
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
' API : envoie un message à un handle (fenêtre ou system)
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal Msg As Long, wParam As Any, lParam As Any) As Long
' API : change le texte d'une fenêtre identifiée par son handle
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
'
Public Function SendTextToNotepad(ByVal sString As String, Optional ByVal vsTitle As Variant) As Boolean
' sString -> chaîne à transmettre à notepad
' vsTitle -> chaîne optionnelle pour personnaliser le caption de notepad
' retourne l'état de réussite
' *nécessite la fonction 'InstanceToWnd' disponible ici : http://www.codyx.org/snippet_recuperer-hwnd-handle-partir-pid-process-id_451.aspx#1462
' lance notepad
Dim lPID As Long
lPID = Shell("notepad.exe", vbNormalFocus)
DoEvents
If lPID Then
' récupère le handle du notepad ouvert
Dim nhWnd As Long
nhWnd = InstanceToWnd(lPID)
If nhWnd Then
' récupère le handle de la zone de texte du notepad
Dim thWnd As Long
thWnd = FindWindowEx(nhWnd, 0&, "Edit", vbNullString)
If thWnd Then
' envoie le texte dans la zone de texte
If SendMessage(thWnd, WM_SETTEXT, ByVal 0&, ByVal sString) Then
' réussite, on personalise le titre
SendTextToNotepad = True
If Not IsMissing(vsTitle) Then
If VarType(vsTitle) = vbString Then Call SetWindowText(nhWnd, CStr(vsTitle))
End If
Else
' échec de l'envoi, on ne laisse pas la fenêtre vide ouverte
Call SendMessage(nhWnd, WM_CLOSE, ByVal HTCAPTION, ByVal vbNullString)
End If
End If
End If
End If
End Function
' ------------------------
' 3 EXEMPLES D'UTILISATION
' ------------------------
Private Sub Command1_Click()
' va ouvrir 3 "nouveaux documents notepad non-enregistrés", et y mettre :
' 1 : une chaine en paramètre (exemple VB6 et VBA)
If Not SendTextToNotepad("je suis un texte" & vbCrLf & "multiligne non enregistré. " & _
"Une aide sur une méthode par exemple...", "'Developed By Exploreur'") Then _
MsgBox "Echec de l'envoi du texte vers notepad"
' 2 : le contenu du presse-papier, s'il y a (exemple VB6 uniquement)
If Clipboard.GetFormat(vbCFText) Then SendTextToNotepad Clipboard.GetText
' 3 : le listing des DLL présentes dans SYSTEM32 (exemple VB6 et VBA nécessitant OS Win2000 ou supp)
Dim asRet() As String, sPath As String
sPath = Environ$("WINDIR") & "\system32\"
'http://www.codyx.org/snippet_lister-tous-fichiers-repertoire_198.aspx#688
If GetFilesPathFromDirectory(sPath, asRet, "*.dll") > -1 Then SendTextToNotepad Join(asRet, vbCrLf), "Listing des DLL"
Erase asRet
End Sub