MsgBox不够大的文字 [英] MsgBox not big enough for text

问题描述

我有一个字符串（msg），这是一个很长的项目列表。我需要把它放在一个msgbox中，但是显示整个文本还不够长。是否有替代方案？

谢谢！

解决方案

消息框功能是VBA的内置功能，不能超过1024个字符。您只能创建自己的UserForm或其他一些替代方法，例如打开和写入未保存的记事本的实例...

打开所有API解决方案记事本并写信给...
注意：如果您运行的VBA 7.0（Office 2010），则必须在每个Declare Statement ...之后添加PtrSafe ...

在您的模块的顶部粘贴API声明和全局变量

  Option Explicit 
 
公共类型PROCESS_INFORMATION 
 hProcess As Long 
 hThread As Long 
 dwProcessID As Long 
 dwThreadID As Long 
结束类型
 
公共类型STARTUPINFO 
 cb As Long 
 lpReserved As String 
 lpDesktop As String 
 lpTitle As String 
 dwX As Long 
 dwY As Long 
 dwXSize As Long 
 dwYSize As Long 
 dwXCountChars As Long 
 dwYCountChars As Long 
 dwFillAttribute As Long 
 dwFlags As Long 
 wShowWindow As Integer 
 cbReserved2 As Integer 
 lpReserved2 As Long 
 hStdInput As Long 
 hStdOutput As Long 
 hStdError As Long 
结束类型
 
'其他API常量
公共常量NORMAL_PRIORITY_CLASS As Long =& H20& 
 Public Const INFINITE As Long = -1& 
 
'窗口消息常量
公共大小WM_GETTEXT =& HD 
公共大小WM_GETTEXTLENGTH =& HE 
公共大小WM_SETTEXT As Long =& HC 
 
'GetWindow常量
公共组件GW_CHILD = 5 
公共组件GW_HWNDFIRST = 0 
公共组件GW_HWNDLAST = 1 
公共组件GW_HWNDNEXT = 2 
公共组件GW_HWNDPREV = 3 
 Public Const GW_OWNER = 4 
 
'Keybd_event常量
公共枚举枚举KBE 
 KBE_KeyDown = 0 
 KBE_KeyUp = 2 
 KBE_ExtKeyDown = 1 
 KBE_ExtKeyUp = 3 
结束枚举
 
'键盘控制键常量
公共Const VK_CONTROL =& H11 
公共Const VK_HOME =& H24 
 
'键盘控制操作常量
公共大小WM_KEYDOWN =& H100 
公共大小WM_KEYUP =& H101 
 
'创建一个新进程
公共声明函数CreateProcessA _ 
 Libkernel32.dll_ 
（ByVal lpApplicationName As String，_ 
 ByVal lpCommandLine As String，_ 
 ByVal lpProcessAttributes As Long，_ 
 ByVal lpThreadAttributes As Long，_ 
 ByVal bInheritHandles As Long，_ 
 ByVal dwCreationFlags As Long，_ 
 ByVal lpEnvironment As Long，_ 
 ByVal lpCurrentDirectory As String，_ 
 ByRef lpStartupInfo As STARTUPINFO，_ 
 ByRef lpProcessInformation As PROCESS_INFORMATION）As Long 
 
'等待直到指定进程已经完成处理其初始输入
'，并且正在等待用户输入，没有输入挂起，或直到超时
'间隔过去。 
公共声明函数WaitForInputIdle _ 
 Libuser32.dll（ByVal hProcess As Long，ByVal dwMilliseconds As Long）As Long 
 
'关闭句柄从CreateProcess API创建和引用
公共声明函数CloseHandle Libkernel32.dll（ByVal hObject As Long）As Long 
 
'返回正在接受用户输入的窗口的句柄。 
公共声明函数GetForegroundWindow Libuser32.dll（）As Long 
 
'桌面窗口句柄
公共声明函数GetDesktopWindow Libuser32.dll（）As Long 
 
'检索窗口句柄
公共声明函数GetWindow Libuser32.dll（ByVal hwnd As Long，ByVal wCmd As Long）As Long 
 
'获取长度一个窗口的标题
公共声明函数GetWindowTextLength Libuser32.dll别名GetWindowTextLengthA（ByVal hwnd As Long）As Long 
 
'以字符串形式获取Window的标题
公共声明函数GetWindowText Libuser32.dll别名GetWindowTextA_ 
（ByVal hwnd As Long，ByVal lpString As String，ByVal nMaxCount As Long）As Long 
 
'返回类或名称的窗口句柄
公共声明函数GetClassName Libuser32.dll别名GetClassNameA_ 
（ByVal hwnd As Long，ByVal lpClassName As String，ByVal nMaxCount As Long）As Long 
 
'Y ou可以使用GetDlgItem函数与任何父子窗口对，而不仅仅是
'对话框。只要hDlg（hWnd）参数指定父窗口，
'子窗口具有唯一标识符（由
'CreateWindow或创建子窗口的CreateWindowEx函数中的hMenu参数指定） ，
'GetDlgItem返回一个有效的句柄到子窗口。 
公共声明函数GetDlgItem Libuser32.dll（ByVal hDlg As Long，ByVal nIDDlgItem As Long）As Long 
 
'发送消息到Windows 
公共声明函数SendMessage Lib user32.dll别名SendMessageA_ 
（ByVal hwnd As Long，ByVal wMsg As Long，ByVal wParam As Long，ByRef lParam As Any）As Long 
 
'找到一个窗口，名称，返回句柄。 
公共声明函数FindWindow Libuser32别名FindWindowA（ByVal lpClassName As String，ByVal lpWindowName As String）As Long 
 
'获取控件窗口句柄。必须指定窗体窗口句柄以获得体面的控件。 
公共声明函数FindWindowEx Libuser32别名FindWindowExA（ByVal hWnd1 As Long，ByVal hWnd2 As Long，ByVal lpsz1 As String，ByVal lpsz2 As String）As Long 
 
'Translates映射）虚拟键代码到扫描代码或字符值
公共声明函数MapVirtualKey Libuser32别名MapVirtualKeyA（ByVal wCode As Long，ByVal wMapType As Long）As Long 
 
'合成按键。系统可以使用这样的合成按键来生成WM_KEYUP或WM_KEYDOWN消息。 
公共声明Sub keybd_event Libuser32（ByVal bVk As Byte，ByVal bScan As Byte，ByVal dwFlags As Long，ByVal dwExtraInfo As Long）
 
'将键盘控制和焦点设置为提供窗口句柄
公共声明函数SetForegroundWindow Libuser32（ByVal hwnd As Long）As Long 
 
'计算机将等待x毫秒数
 
公共声明子Sleep Libkernel32（ByVal dwMilliseconds As Long）
  

Write2Notepad函数打开一个新的记事本实例并写入给它如果成功，那么它将返回记事本实例的进程ID。

 公共函数Write2Notepad（strInText As String）As Long 
 Const nEditID = 15'记事本编辑控件的标识符ID 
 Dim PI As PROCESS_INFORMATION 
 Dim SI As STARTUPINFO 
 Dim RetVal As Long，hWndNote As Long，chWnd As Long，LngVal As Long，PID As Long 
 Dim strCaption As String，strClassName As String 
 
'初始化STARTUPINFO结构
 SI.cb = Len（SI）
 
 '启动应用程序
 RetVal = CreateProcessA（lpApplicationName：= vbNullString，_ 
 lpCommandLine：=Notepad.exe，_ 
 lpProcessAttributes：= 0& _ 
 lpThreadAttributes：= 0& _ 
 bInheritHandles：= 1& _ 
 dwCreationFlags：= NORMAL_PRIORITY_CLASS，_ 
 lpEnvironment：= 0& _ 
 lpCurrentDirectory：= vbNullString，_ 
 lpStartupInfo：= SI，_ 
 lpProcessInformation：= PI）
 
'等待应用程序f inish加载
虽然WaitForInputIdle（PI.hProcess，INFINITE）<> 0 
 DoEvents 
 Wend 
 
'获取新打开的记事本应用程序的进程ID 
 PID = PI.dwProcessID 
 
'关闭所有启动过程信息的线程和句柄
'（这不是窗口句柄，强烈推荐）
调用CloseHandle（PI.hThread）
调用CloseHandle（PI.hProcess）
 
'获取活动应用程序的窗口句柄
'注意：当在调试器中逐步执行代码时，将返回VB编辑器的窗口句柄，
'设置一个断点在GetForegroundWindow下面。 
 hWndNote = GetForegroundWindow（）
如果hWndNote = 0然后'
'如果ForegroundWindow句柄不可用获取桌面的第一个子窗口
 hWndNote = GetWindow（GetDesktopWindow， GW_CHILD）
 End If 
'Do While循环来验证hWndNote窗口句柄属于一个空的无标题记事本窗口
 
 chWnd = 0 
'获取窗口标题
 LngVal = GetWindowTextLength（hWndNote）+ 1 
 strCaption = String（LngVal，Chr $（0））
 LngVal = GetWindowText（hWndNote，strCaption，LngVal）
 strCaption = IIf（LngVal > 0，Left（strCaption，LngVal），）
 
'获取窗口类名称
 LngVal = GetWindowTextLength（hWndNote）+ 1 
 strClassName = String（LngVal， Chr $（0））
 LngVal = GetClassName（hWndNote，strClassName，LngVal）
 strClassName = IIf（LngVal> 0，Left（strClassName，LngVal），）
 
如果strCaption像Untitled  -  Notepad和strClassName =Notepad然后
'获取编辑控件的窗口句柄，它是Notepad的子窗口
 chWnd = GetDlgItem（hWndNote，nEditID）
'获取记事本文本的字符数，以确保它是空（应返回0）
如果SendMessage（chWnd，WM_GETTEXTLENGTH，0，0）= 0然后
退出Do 
结束如果
结束如果
'获取下一个窗口
 hWndNote = GetWindow（hWndNote，GW_HWNDNEXT）
'处理Windows事件。 
 DoEvents 
循环，而hWndNote<> 0 
如果hWndNote = 0然后
 MsgBox找不到记事本的窗口句柄。 
 Write2Notepad = 0 
退出函数
结束如果
如果chWnd = 0然后
'返回子窗口Hwnd  - 类似于GetDlgItem 
 chWnd = FindWindowEx（hWndNote ，ByVal 0& vbNullString，vbNullString）
 End If 
 DoEvents 
 
'将文本值发送到记事本
 RetVal = SendMessage（chWnd，WM_SETTEXT，Len（strInText ）+ 1，ByVal strInText）
 
'为了确保光标位置在左上角，Keyboard Control强制按下Ctrl键
 keybd_event VK_CONTROL，MapVirtualKey（VK_CONTROL，0） ，KBE_KeyDown，0 
'将Home输入发送到记事本（模拟CTRL + Home操作将光标移动到记事本顶部
 SendMessage chWnd，WM_KEYDOWN，VK_HOME，0 
 SendMessage chWnd，WM_KEYUP，VK_HOME，0 
'模拟Ctrl键的按键或解压缩
 keybd_event VK_CONTROL，MapVirtualKey（VK_CONTROL，0），KBE_KeyUp，0 
 
'确保记事本窗口有Cursor Focus 
 SetForegroundWin dow（hWndNote）
 
'如果Settext SendMessage调用的值等于1，则返回进程ID（True）= success 
如果CBool​​（RetVal）= True，PID> 0然后
 Write2Notepad = PID 
 Else 
 Write2Notepad = 0 
 End If 
 End Function 
  

测试Write2Notepad函数的例程

  Sub TestWriting2Notepad（）
 Dim strTestText As String 
 Dim lngProcID As Long 
 Dim oNotepad As Object 
 
 strTestText =This& vbCrLf& 是& vbCrLf& 测试& vbCrLf& 看看& vbCrLf& 我可以& vbCrLf& _ 
 vbCrLf& vbCrLf& 写& vbCrLf& vbCrLf& 2& vbCrLf& vbCrLf& 记事本！！！ 
 
 lngProcID = Write2Notepad（strTestText）
如果lngProcID = 0然后
 Debug.Print出了问题...这可能是你的错！ 
 Else 
 Debug.Print您成功写入记事本API样式！ 
 Do 
 DoEvents 
睡眠500 
设置oNotepad =没有
在错误恢复下一步
设置oNotepad = GetObject（winmgmts：root\cimv2：Win32_Process .Handle ='& lngProcID&'）
错误GoTo 0 
循环，而不是oNotepad是没有
'仅为示例 - 删除以下行
 MsgBox您已关闭记事本
如果
 End Sub 
  

上述代码可能会像很多麻烦或更复杂的，但它可能会更可靠和有效地工作，然后任何其他方法。

以下功能将您的消息复制到剪贴板使用MS剪辑工具，打开记事本，然后将剪贴板内容（您的消息）粘贴到记事本中...这样，您不必将任何东西保存到文件中，并且可以轻松关闭...或者如果您选择

  Option Explicit 
公开声明Sub Sleep Libkernel32 （ByVal dwMilliseconds As Long）
 
 Sub Print2Notepad（strMessage）
 Dim oShell As Object，oExec As Object，oIn As Object 
设置oShell = CreateObject（WScript.Shell） 
设置oExec = oShell.Exec（clip）
设置oIn = oExec.StdIn 
 oIn.WriteLine strMessage 
 oIn.Close 
尽管oExec.Status = 0 
睡眠100 
循环
设置oIn =没有
设置oExec =没有
 oShell.Run记事本，1，False 
睡眠250 
 oShell.SendKeys^ v
 End Sub 
 
子测试（）
调用Print2Notepad（这是一个测试消息）
 End Sub 
  

您还可以添加一个附加例程来睡眠，而记事本打开以停止代码，如果你需要.. 。见下面

  Sub Print2Notepad_WaitTillClose（strMessage）
 Dim oShell As Object，oExec As Object，oIn As Object 
 Dim iPID As Variant，oNotepad As Object 
设置oShell = CreateObject（WScript.Shell）
设置oExec = oShell.Exec（clip）
设置oIn = oExec.StdIn 
 oIn.WriteLine strMessage 
 oIn.Close 
 Do While oExec.Status = 0 
 Sleep 100 
 Loop 
 Set oIn = Nothing 
 Set oExec = Nothing 
 iPID = oShell.Exec（Notepad）。ProcessID 
睡眠500 
 oShell.SendKeys^ v
 Do 
睡眠500 
设置oNotepad = Nothing 
 On Error Resume Next 
设置oNotepad = GetObject（winmgmts：root\cimv2：Win32_Process.Handle ='& iPID& $$ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ b b b b b b b b b b b b b b 
 
' $ b End Sub 
  

编辑：
我只是意识到我写了上面的代码工作对于VBScript ...由于这是Excel，如果您想查看其他方法将内容复制到剪贴板而不使用WshShell.Exec方法;您还可以尝试：

  Dim DataObj As New MSForms.DataObject 
 Dim S As String 
 S = Hello World
 DataObj.SetText S 
 DataObj.PutInClipboard 
  

要使用您的代码中的DataObject，您必须设置对Microsoft Forms 2.0对象库的引用。这也可以通过创建一个UserForm然后删除它来完成...引用将保留（Excel 2007）。

对于其他剪贴板API和代码，请查看：

1） http：// www .cpearson.com / excel / Clipboard.aspx
2） http://msdn.microsoft.com/en-us/library/office/ff192913.aspx
3） http://msdn.microsoft.com/en-us/library/windows/desktop/ms648709%28v = vs85％29.aspx

还有其他可能的方法，但我认为这些是最稳定可靠的。我将离开代码的方式，这样它将适用于VBA和VBScript

I have a string (msg) that is pretty much a very long list of items. I need to put this in a msgbox but it is not long enough to show the whole text. Is there an alternative to this?

Thank you!

解决方案

The Message Box function is a built-in function of VBA and cannot exceed 1024 Characters. You are limited to creating your own UserForm or some other alternative... Such as opening and writing to an unsaved instance of notepad...

An ALL API solution to open Notepad and Write your message to it... NOTE: If your running VBA 7.0 (Office 2010) then you'll have to add PtrSafe just after each Declare Statement...

At the top of your module paste the API Declarations and Global Variables

Option Explicit

Public Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessID As Long
    dwThreadID As Long
End Type

Public Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

'Miscellaneous API Constants
Public Const NORMAL_PRIORITY_CLASS As Long = &H20&
Public Const INFINITE As Long = -1&

'Window Message Constants
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE
Public Const WM_SETTEXT As Long = &HC

'GetWindow Constants
Public Const GW_CHILD = 5
Public Const GW_HWNDFIRST = 0
Public Const GW_HWNDLAST = 1
Public Const GW_HWNDNEXT = 2
Public Const GW_HWNDPREV = 3
Public Const GW_OWNER = 4

'Keybd_event Constants
Public Enum enumKBE
     KBE_KeyDown = 0
     KBE_KeyUp = 2
     KBE_ExtKeyDown = 1
     KBE_ExtKeyUp = 3
End Enum

'Keyboard Control Key Constants
Public Const VK_CONTROL = &H11
Public Const VK_HOME = &H24

'Keyboard Control Action Constants
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101

'Create a new process
Public Declare Function CreateProcessA _
    Lib "kernel32.dll" _
      (ByVal lpApplicationName As String, _
       ByVal lpCommandLine As String, _
       ByVal lpProcessAttributes As Long, _
       ByVal lpThreadAttributes As Long, _
       ByVal bInheritHandles As Long, _
       ByVal dwCreationFlags As Long, _
       ByVal lpEnvironment As Long, _
       ByVal lpCurrentDirectory As String, _
       ByRef lpStartupInfo As STARTUPINFO, _
       ByRef lpProcessInformation As PROCESS_INFORMATION) As Long

'Waits until the specified process has finished processing its initial input
'and is waiting for user input with no input pending, or until the time-out
'interval has elapsed.
Public Declare Function WaitForInputIdle _
    Lib "user32.dll" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long

'Closes Handles Created and referenced from the CreateProcess API
Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

'Returns the Window Handle of the Window that is accepting User input.
Public Declare Function GetForegroundWindow Lib "user32.dll" () As Long

'Desktop Window handle
Public Declare Function GetDesktopWindow Lib "user32.dll" () As Long

'Retrieves Window handle
Public Declare Function GetWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal wCmd As Long) As Long

'Get the length of a Window's caption
Public Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long

'Get the caption of a Window as a string
Public Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" _
      (ByVal hwnd As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long

'Returns the Class or catagory name of an Window handle
Public Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" _
        (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

'You can use the GetDlgItem function with any parent-child window pair, not just with
'dialog boxes. As long as the hDlg (hWnd) parameter specifies a parent window and the
'child window has a unique identifier (as specified by the hMenu parameter in the
'CreateWindow  or CreateWindowEx  function that created the child window),
'GetDlgItem returns a valid handle to the child window.
Public Declare Function GetDlgItem Lib "user32.dll" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long

'Send messages to windows
Public Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
        (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

'Finds a window with the name, returns the handle.
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'Gets a controls window handle. The form window handle must be specified to get a decent control.
Public 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

'Translates (maps) a virtual-key code into a scan code or character value
Public Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long

'Synthesizes a keystroke. The system can use such a synthesized keystroke to generate a WM_KEYUP or WM_KEYDOWN message.
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

'Sets Keyboard control and focus to the provided Window handle
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

'Computer will wait for x number of milliseconds

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

Write2Notepad function opens a new instance of Notepad and writes to it. If it succeeds, then it will return the Process ID of the Notepad instance.

Public Function Write2Notepad(strInText As String) As Long
Const nEditID = 15  'Identifier ID to Notepad's Edit Control
Dim PI As PROCESS_INFORMATION
Dim SI As STARTUPINFO
Dim RetVal As Long, hWndNote As Long, chWnd As Long, LngVal As Long, PID As Long
Dim strCaption As String, strClassName As String

'Initialize the STARTUPINFO structure
SI.cb = Len(SI)

'Start the application
RetVal = CreateProcessA(lpApplicationName:=vbNullString, _
    lpCommandLine:="Notepad.exe", _
    lpProcessAttributes:=0&, _
    lpThreadAttributes:=0&, _
    bInheritHandles:=1&, _
    dwCreationFlags:=NORMAL_PRIORITY_CLASS, _
    lpEnvironment:=0&, _
    lpCurrentDirectory:=vbNullString, _
    lpStartupInfo:=SI, _
    lpProcessInformation:=PI)

'Wait for the application to finish loading
While WaitForInputIdle(PI.hProcess, INFINITE) <> 0
    DoEvents
Wend

'Get the Process ID of the newly opened Notepad application
PID = PI.dwProcessID

'Close all Threads and handles for the Startup Process Information
'    (This is not the Window Handle and is highly recommended)
Call CloseHandle(PI.hThread)
Call CloseHandle(PI.hProcess)

'Get the Active Application's Window Handle
  'Note: when stepping through code in debugger this Will Return the VB Editor's Window Handle,
  ' Set a break point below GetForegroundWindow instead.
hWndNote = GetForegroundWindow()
If hWndNote = 0 Then   '
    'If the ForegroundWindow Handle isn't available Get the first Child Window to the Desktop
    hWndNote = GetWindow(GetDesktopWindow, GW_CHILD)
End If
'Do While loop to verify the hWndNote Window Handle belongs to an Empty Untitled Notepad Window
Do
    chWnd = 0
    'Get Window Caption
    LngVal = GetWindowTextLength(hWndNote) + 1
    strCaption = String(LngVal, Chr$(0))
    LngVal = GetWindowText(hWndNote, strCaption, LngVal)
    strCaption = IIf(LngVal > 0, Left(strCaption, LngVal), "")

    'Get the Window Class name
    LngVal = GetWindowTextLength(hWndNote) + 1
    strClassName = String(LngVal, Chr$(0))
    LngVal = GetClassName(hWndNote, strClassName, LngVal)
    strClassName = IIf(LngVal > 0, Left(strClassName, LngVal), "")

    If strCaption Like "Untitled - Notepad" And strClassName = "Notepad" Then
        'Get the window handle of the Edit Control which is a child window of Notepad
        chWnd = GetDlgItem(hWndNote, nEditID)
        'Get the character count of the notepad text to ensure it is empty (Should return 0)
        If SendMessage(chWnd, WM_GETTEXTLENGTH, 0, 0) = 0 Then
            Exit Do
        End If
    End If
    'Get the next Window
    hWndNote = GetWindow(hWndNote, GW_HWNDNEXT)
    'Process Windows events.
    DoEvents
Loop While hWndNote <> 0
If hWndNote = 0 Then
    MsgBox "Cannot find Notepad's Window Handle."
    Write2Notepad = 0
    Exit Function
End If
If chWnd = 0 Then
    'Returns child Window Hwnd - Similar to GetDlgItem
    chWnd = FindWindowEx(hWndNote, ByVal 0&, vbNullString, vbNullString)
End If
DoEvents

'Sends the Text Value to Notepad
RetVal = SendMessage(chWnd, WM_SETTEXT, Len(strInText) + 1, ByVal strInText)

'To ensure the cursor position is at the top left the Keyboard Control forces the "Ctrl" Key is pressed
keybd_event VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KBE_KeyDown, 0
'Sends the "Home" input to Notepad (Simulates the CTRL + Home action to bring the cursor to the top of Notepad
SendMessage chWnd, WM_KEYDOWN, VK_HOME, 0
SendMessage chWnd, WM_KEYUP, VK_HOME, 0
'Simulates the Key up or unpressing of the "Ctrl" Key
keybd_event VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KBE_KeyUp, 0

'Ensures the Notepad window has the Cursor Focus
SetForegroundWindow (hWndNote)

'Returns the Process ID if the Value of the Settext SendMessage call equals a value of 1 (True) = successful
If CBool(RetVal) = True And PID > 0 Then
    Write2Notepad = PID
Else
    Write2Notepad = 0
End If
End Function

Routine to Test the Write2Notepad Function

Sub TestWriting2Notepad()
Dim strTestText As String
Dim lngProcID As Long
Dim oNotepad As Object

strTestText = "This" & vbCrLf & "is" & vbCrLf & "a Test" & vbCrLf & "to see if" & vbCrLf & "I can" & vbCrLf & _
  vbCrLf & vbCrLf & "Write" & vbCrLf & vbCrLf & "2" & vbCrLf & vbCrLf & "Notepad!!!"

lngProcID = Write2Notepad(strTestText)
If lngProcID = 0 Then
    Debug.Print "Something went wrong... It was probably your fault!"
Else
    Debug.Print "You Successfully Wrote to Notepad...  API Style!"
    Do
        DoEvents
        Sleep 500
        Set oNotepad = Nothing
        On Error Resume Next
        Set oNotepad = GetObject("winmgmts:root\cimv2:Win32_Process.Handle='" & lngProcID & "'")
        On Error GoTo 0
    Loop While Not oNotepad Is Nothing
    ' For Example only - Delete Below Line
    MsgBox "You Closed Notepad"
End If
End Sub

The above code might look like a lot of trouble or more complicated but it will likely work much more reliably and efficiently then any other method.

The below function will copy your message to the clipboard using the MS clip tool, open notepad, and then paste the clipboard contents (your message) into Notepad... This way you don't have to save anything to a file and its easily closed... Or you can save it if you choose.

Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub Print2Notepad(strMessage)
Dim oShell As Object, oExec As Object, oIn As Object
Set oShell = CreateObject("WScript.Shell")
Set oExec = oShell.Exec("clip")
Set oIn = oExec.StdIn
oIn.WriteLine strMessage
oIn.Close
Do While oExec.Status = 0
    Sleep 100
Loop
Set oIn = Nothing
Set oExec = Nothing
oShell.Run "Notepad", 1, False
Sleep 250
oShell.SendKeys "^v"
End Sub

Sub test()
Call Print2Notepad("This is a test message")
End Sub

You can also add an additional routine to "Sleep" while notepad is open to halt code if you need... See Below

Sub Print2Notepad_WaitTillClose(strMessage)
Dim oShell As Object, oExec As Object, oIn As Object
Dim iPID As Variant, oNotepad As Object
Set oShell = CreateObject("WScript.Shell")
Set oExec = oShell.Exec("clip")
Set oIn = oExec.StdIn
oIn.WriteLine strMessage
oIn.Close
Do While oExec.Status = 0
    Sleep 100
Loop
Set oIn = Nothing
Set oExec = Nothing
iPID = oShell.Exec("Notepad").ProcessID
Sleep 500
oShell.SendKeys "^v"
Do
    Sleep 500
    Set oNotepad = Nothing
    On Error Resume Next
    Set oNotepad = GetObject("winmgmts:root\cimv2:Win32_Process.Handle='" & iPID & "'")
    On Error GoTo 0
Loop While Not oNotepad Is Nothing

' For Example only - Delete Below Line
MsgBox "You Closed Notepad"
End Sub

EDIT: I just realized that I wrote the above code to work for VBScript... Since this is Excel, if you want to look into other methods to copy contents to the Clipboard without using the WshShell.Exec method; you can also try:

Dim DataObj As New MSForms.DataObject
Dim S As String
S = "Hello World"
DataObj.SetText S
DataObj.PutInClipboard

To use the DataObject in your code, you must set a reference to the Microsoft Forms 2.0 Object Library. This can also be done by creating a UserForm and then Deleting it... The reference will remain (Excel 2007).

For additional Clipboard API's and code take a look at:

1) http://www.cpearson.com/excel/Clipboard.aspx 2) http://msdn.microsoft.com/en-us/library/office/ff192913.aspx 3) http://msdn.microsoft.com/en-us/library/windows/desktop/ms648709%28v=vs.85%29.aspx

There are other possible methods but I think these are the most stable and reliable. I will leave the code the way it is so that it will work for both VBA and VBScript

这篇关于MsgBox不够大的文字的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！