VB控制记事本句柄的例子

Buffett123

下面是VB代码，用句柄，实现对一个已经打开的记事本（新建 文本文档.txt）另存到桌面的功能，但代码只运行到出现另存为的窗口就停止了，哪位高手可以补上后面的？谢谢！
Private Declare Function GetMenu Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetMenuItemID Lib "user32.dll" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetSubMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Const WM_COMMAND As Long = &H111

Private Sub Command1_Click()
Dim hWnd As Long, hMenu As Long, MenuID As Long
hWnd = FindWindow(vbNullString, "新建 文本文档.txt - 记事本") '记事本的句柄，默认新建
hMenu = GetMenu(hWnd)
hMenu = GetSubMenu(hMenu, 0)                   '"文件"菜单的句柄
MenuID = GetMenuItemID(hMenu, 3)             '子菜单"另存为"的ID
SendMessage hWnd, WM_COMMAND, MenuID, ByVal 0
End Sub

Admin

   

很遗憾通知楼上朋友，您的帖子在24小时之内没有任何回复！

通常情况下，本论坛发布的主题帖会在8小时被回复或处理。您的帖子在24小时之内未被回复，其中的原因可能是：

1、问题表述不清、模棱两可，难以理解，帮助者被搞晕了，夺帖而出；
2、没有上传必要的附件，或附件被遗忘在某个角落；
3、发帖提问时，语气带棱角、带挑衅，不幸被列入不受欢迎的帖子；
4、所提问题不成立，或提不合理的要求，乐于助人者使出“走为上”之计；
5、话题较偏、较冷或者发布到了不合适的版块，暂时无人问津，顾影自怜。


为了提高您的问题解决效率，我们推荐您阅读以下文章：
* 如何发表新话题和上传附件：http://club.excelhome.net/thread-45649-1-1.html
* 发帖的技巧：http://club.excelhome.net/thread-176339-1-1.html
* EH技术论坛的最佳学习方法：http://club.excelhome.net/thread-117862-1-1.html

cumulonimbus

帮你顶起。

baoshishang

楼主:
   
   用句柄，实现对一个已经打开的记事本（新建 文本文档.txt）另存到桌面的功能，但代码只运行到出现另存为的窗口就停止了   

   你已经走到门口了！
   继续找到当前新出现窗口需要操作控件的句柄及相关摁钮，在程序中继续输入相关命令，这样应该可以了

   

  

chenword

虽然这个帖子过去好长时间了，今天刚看到，可还是想知道答案，哪位老师给补充一下，比如存成D盘下的节ABC.txt如何做呢？

一把小刀闯天下

'win7-64 + office10-32

Option Explicit

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32 " Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const WM_GETTEXT = &HD, WM_GETTEXTLENGTH = &HE

Sub test()
  Dim s As String, myhwnd As Long, size As Long
  myhwnd = FindWindow(vbNullString, "abc - 记事本") '可能为"abc.txt - 记事本",可用spy++查看
  myhwnd = FindWindowEx(myhwnd, 0&, "Edit", vbNullString)
  If myhwnd = 0 Then MsgBox "!!": Exit Sub
  size = SendMessage(myhwnd, WM_GETTEXTLENGTH, 0, 0)
  s = Space(size)
  SendMessage myhwnd, WM_GETTEXT, size, ByVal s
  Debug.Print "----------"
  Debug.Print Trim(s)
  Debug.Print "----------"
  Open "d:\efg.txt" For Output As #1
  Print #1, s
  Close #1
End Sub

一把小刀闯天下

审核中，，，

lss001

Declare Function SendMessage& Lib "user32.dll" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
Declare Function PostMessage& Lib "user32" Alias "PostMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
Declare Function FindWindow& Lib "user32.dll" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String)
Declare Function FindWindowEx& Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 _
    As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String)
Declare Function GetMenu& Lib "user32.dll" (ByVal hwnd As Long)
Private Declare Function GetSubMenu& Lib "user32.dll" _
    (ByVal hMenu As Long, ByVal nPos As Long)
Declare Function GetMenuItemID& Lib "user32.dll" _
    (ByVal hMenu As Long, ByVal nPos As Long)
Declare Function SetWindowPos& Lib "user32" _
    (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, _
    ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Const WM_COMMAND = &H111, WM_SETTEXT = &HC, HWND_BOTTOM = 1, _
    WM_CLOSE = &H10, WM_CLICK = &HF5, SWP_NOSIZE = &H1, SWP_NOMOVE = &H2
Sub jspjb() 'API记事本操作
    Dim hwnd&, hwndz&, hwnds&, hMenu&, MenuID&, i&, j&, rt&, pt&, ap&: vs = vbNullString
    Shell "notepad.exe", vbMinimizedFocus '打开记事本程序
    hwnd = FindWindow("notepad", vs) '记事本句柄
    hwndz = FindWindowEx(hwnd, 0, "Edit", vbNullString) '编辑框句柄
    SendMessage hwndz, WM_SETTEXT, 0, ByVal "中国人民从此站起来了！"
    hMenu = GetMenu(hwnd)
    hMenu = GetSubMenu(hMenu, 0) '文件/菜单句柄
    MenuID = GetMenuItemID(hMenu, 3) '子菜单/另存为ID
    PostMessage hwnd, WM_COMMAND, MenuID, ByVal 0 '打开另存为对话框
    Application.Wait Now + TimeValue("00:00:02")
    hwnds = FindWindow(vbNullString, "另存为") '获取另存为对话框句柄
    SetWindowPos hwnds, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
    ReDim Childh(0): Childh(0) = hwnds
    Do While i <= UBound(Childh) '枚举另存为对话框子句柄
        pt = Childh(i): ap = 0
        rt = FindWindowEx(pt, ap, vs, vs)
        Do While rt > 0
            j = j + 1
            ReDim Preserve Childh(0 To j)
            Childh(j) = rt: ap = rt
            rt = FindWindowEx(pt, ap, vs, vs)
        Loop
        i = i + 1
    Loop
    SendMessage Childh(37), WM_SETTEXT, 0, ByVal _
    "" & ThisWorkbook.Path & "\abc.txt"
    '输入文件路径/名称/后缀
    SendMessage Childh(5), WM_CLICK, 0, 0 '自动点击保存
    SendMessage hwnd, WM_CLOSE, 0, 0 '关闭记事本程序
End Sub

yf_home

lss001 发表于 2019-3-2 19:13
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
    (ByVal hwnd As ...

测试了一下，有点问题，

1、SendKeys "D:\abc.txt", True '输入文件路径/名称/后缀
     这句，实际写不到完整路径
    我也不知道该咋修改

2、SendKeys "{TAB} ", True '将焦点定位到保存按钮上
     这句，也定位不到保存按钮，改为这样应该可以：
      Application.SendKeys "%s", True    ' ALT + S

lss001

可以参考楼上更新，全程api！