Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")

text = "<font color='#D200D2'><strong>这是一个调用hta自定义对话框的简单例子</strong></font>" _
    &vbCrLf&"下面将演示捕获按钮点击动作"&vbCrLf& "请点击下面其中一个按钮"

c = DIYmsgbox(replace(text, VbCrLf, "<br/>"))
If c = "" Then
    msgbox "你没有点击按钮！"
Else
    msgbox "你点击了 """& c &""""
End If

'自定义对话框
Function DIYmsgbox(text)
    Set htafile = fso.OpenTextFile("$temp.hta", 2, true)
    htafile.Write "<title>提示</title><script>window.resizeTo(450,220);" & _
        "var fso=new ActiveXObject('Scripting.FileSystemObject');var StdOut = fso.GetStandardStream(1);" & _
        "function fun(c){StdOut.Write(c);close();}</script>" & _
        "<div id='text' style='text-align:center;'>"& text &"</div><br/>" & _
        "<div style='position:fixed; bottom:0;text-align:center;'>" & _
        "<input type='button' style='color:#FF0000;' value='vbs' onclick='fun(this.value)'>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;" & _
        "<input type='button' style='color:#00BB00;' value='hta' onclick='fun(this.value)'></div>"
    htafile.Close
    Set exc = ws.Exec("mshta.exe "& fso.GetFile(WSH.ScriptFullName).ParentFolder.Path &"\$temp.hta")
    DIYmsgbox = exc.StdOut.ReadLine()
    fso.DeleteFile "$temp.hta"
End Function
复制代码