ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

   
EH云课堂-专业的职场技能充电站 限时送,魔方网表将Excel变在线系统 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 高效办公必会的Office实战技巧 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 3801|回复: 9

[求助] VB控制记事本句柄的例子

[复制链接]

TA的精华主题

TA的得分主题

发表于 2011-8-7 20:42 | 显示全部楼层 |阅读模式
下面是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

TA的精华主题

TA的得分主题

发表于 2011-8-9 07:05 | 显示全部楼层

〖Excel Home友情提示〗

   

很遗憾通知楼上朋友,您的帖子在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

TA的精华主题

TA的得分主题

发表于 2011-10-29 18:57 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2012-8-5 09:31 | 显示全部楼层
楼主:
   
   用句柄,实现对一个已经打开的记事本(新建 文本文档.txt)另存到桌面的功能,但代码只运行到出现另存为的窗口就停止了   

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

   

  

TA的精华主题

TA的得分主题

发表于 2017-2-3 23:34 | 显示全部楼层
虽然这个帖子过去好长时间了,今天刚看到,可还是想知道答案,哪位老师给补充一下,比如存成D盘下的节ABC.txt如何做呢?

TA的精华主题

TA的得分主题

发表于 2019-1-12 22:19 | 显示全部楼层
'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

TA的精华主题

TA的得分主题

发表于 2019-1-12 22:21 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-3-2 19:13 来自手机 | 显示全部楼层
本帖最后由 lss001 于 2019-3-14 13:38 编辑

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_COLSE = &H2, 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_COLSE, 0, 0 '关闭记事本程序
End Sub

TA的精华主题

TA的得分主题

发表于 2019-3-4 08:28 | 显示全部楼层
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



TA的精华主题

TA的得分主题

发表于 2019-3-4 10:44 来自手机 | 显示全部楼层
本帖最后由 lss001 于 2019-3-5 07:13 编辑

可以参考楼上更新,全程api!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-3-21 14:03 , Processed in 0.082807 second(s), 13 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 2001-2017 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表