mshta usage

  • mshta is short for MicroSoft Html Application. It could run html file or html string as a parameter.
  • what is interesting is you can use it in a batch command or batch file and you can use some functions like in the browser such as show a dialog and so on.
  • with mshta you can run javascript code and vbscipt code in windows command line or batch file.

Example 1, show a message box in many different ways.

mshta javascript:window.execScript("msgBox('hello world!'):window.close","vbs") 
mshta vbscript:window.execScript("alert('hello world!');close()","javascript") 
mshta vbscript:window.execScript("msgBox('hello world!'):window.close","vbs")
mshta javascript:alert("hello world!");close()
mshta vbscript:msgbox("hello world!",64,"Title")(window.close)
mshta vbscript:CreateObject("Wscript.Shell").popup("hello world!",7,"Title",64)(window.close) 

Example 2, execute more than one commands in one line.(In fact this already shows in Example 1, you must find it, it is the close command.)

mshta vbscript:execute("msgbox ""BOX one"":msgbox ""BOX two"":window.close") 
mshta vbscript:(msgbox("BOX one"))(msgbox("BOX two")(window.close))
mshta javascript:alert("BOX one",);alert("BOX two");close()
mshta javascript:execScript("msgBox('BOX one'):msgBox('BOX two'):window.close","vbs")

Example 3, use ActiveXObject in script to use more sophisticated functions of the OS.

mshta vbscript:createobject("sapi.spvoice").speak("Hello, I am tom, let's do something fun.")(window.close) 
mshta "javascript:close((V=(v=new ActiveXObject('SAPI.SpVoice')).GetVoices()).count&&v.Speak('Hello! I am '+V(0).GetAttribute('Gender')))"

Example 4, javascript is much more easy to use, because you do not have to add so many double qoutes like in vbscript.

mshta "javascript:var objFSO=new ActiveXObject('Scripting.FileSystemObject'); var objFile = objFSO.CreateTextFile('test.txt',true); objFile.Write('Hello World.');objFile.Close();close();"
mshta "javascript:var sh=new ActiveXObject( 'WScript.Shell' ); sh.Popup( 'hello world!', 10, 'Title!', 64 );close()"

Example 5, several ways to calculate the free memory of your computer.

mshta "javascript:close(new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(GetObject('winmgmts:').ExecQuery('Select * from Win32_PerfFormattedData_PerfOS_Memory').ItemIndex(0).AvailableBytes));"|more
for  /f "usebackq" %a in (`mshta ^"javascript^:close^(new ActiveXObject^(^'Scripting.FileSystemObject^'^).GetStandardStream^(1^).Write^(GetObject^(^'winmgmts:^'^).ExecQuery^(^'Select * from Win32_PerfFormattedData_PerfOS_Memory^'^).ItemIndex^(0^).AvailableBytes^)^);^"^|more`) do set free_mem=%a
mshta "javascript:close(new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(GetObject('winmgmts:').ExecQuery('Select * from Win32_PerfFormattedData_PerfOS_Memory').ItemIndex(0).AvailableMBytes));"|for /f %%a in ('more') do set free_mem=%%a

Example 6, another way to calculate free memory.

@echo off
setlocal
:: Define simple macros to support JavaScript within batch
set "beginJS=mshta "javascript:close(new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write("
set "endJS=));""
:: Direct instantiation requires that output is piped
%beginJS% GetObject('winmgmts:').ExecQuery('Select * from Win32_PerfFormattedData_PerfOS_Memory').ItemIndex(0).AvailableBytes %endJS% | findstr "^"
:: FOR /F does not need pipe
for /f %%N in (
  '%beginJS% GetObject('winmgmts:').ExecQuery('Select * from Win32_PerfFormattedData_PerfOS_Memory').ItemIndex(0).AvailableBytes %endJS%'
) do set free_mem=%%N
echo free_mem=%free_mem%

Example 7, show color pallets dialog.

mshta "about:<script>function b(){new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(d.ChooseColorDlg().toString(16));close();}</script><body onload='b()'><object id='d' classid='clsid:3050f819-98b5-11cf-bb82-00aa00bdce0b'></object></body>"|more 

Example 8, show screen resolution.

mshta "javascript:res=screen.width+'x'+screen.height;alert(res);close();" 1 | more

Example 9, use clipboard data.

for /f "usebackq tokens=1,* delims=[]" %i in (`mshta "javascript:close(new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(clipboardData.getData('Text')));"^|find /v /n ""`) do @set "c[%i]=%j" 

Example 10, use javascript setTimeout to delay some time interval to execute a command.

mshta javascript:setTimeout('close()',10000)

Example 11, show File Open Select Dialog, you can redirect your output to the command window or to a file or to a variable.

mshta "about:<input type=file id=FILE><script>FILE.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);</script>"|more

mshta "about:<input type=file id=FILE><script>FILE.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(FILE.value);close();</script>">test.txt

mshta "about:<input type=file id=FILE><script>FILE.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(FILE.value);close();</script>">temp && set /p a=<temp

for /f "delims=" %%i in ('mshta "about:<input type=file id=FILE><script>FILE.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(FILE.value);close();</script>"') do set a=%%i

Example 12, show Open For Folder Dialog to select a directory, and you can assign it to a variable.

for /f "delims=" %%i in ('mshta "javascript:var folder=new ActiveXObject("Shell.Application").BrowseForFolder(0,'选择要处理的文件夹', 0, '').self.path;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(folder);close();"') do set input=%%i

Example 13, execute batch command with parameters which has spaces.

::a.bat
@echo off
set text=Hello World
mshta vbscript:createobject("WScript.Shell").Run("b.bat "+"""%text%""",0)(window.close)
::b.bat
@echo off
mshta "javascript:var sh=new ActiveXObject( 'WScript.Shell' ); sh.Popup( '%~1', 10, 'Title!', 64 ); close()"

Example 14, ultimate function, run a html file.

<!-- :: Batch section
@echo off
setlocal
echo Select an option:
for /F "delims=" %%a in ('mshta.exe "%~F0"') do set "HTAreply=%%a"
echo End of HTA window, reply: "%HTAreply%"
goto :EOF
-->

<HTML>
<HEAD>
<HTA:APPLICATION SCROLL="no" SYSMENU="no" >

<TITLE>HTA Radio Buttons</TITLE>
<SCRIPT language="JavaScript">
window.resizeTo(440,170);

var reply = "No button selected";
function closeHTA(){
   var fso = new ActiveXObject("Scripting.FileSystemObject");
   fso.GetStandardStream(1).WriteLine(reply);
   window.close();
}

</SCRIPT>
</HEAD>
<BODY>
<p>Which prize do you prefer?</p>
<label><input type="radio" name="prize" onclick="reply=this.value" value="House">House</label>
<label><input type="radio" name="prize" onclick="reply=this.value" value="Money">$1 million</label>
<label><input type="radio" name="prize" onclick="reply=this.value" value="None">No prize thanks, I'm already happy <b>:)</b></label>
<br><br>
<button onclick="closeHTA();">Submit</button>
</BODY>
</HTML>

reference1
reference2
reference3

还是报错 错误13:类型不匹配 发生在区块2-5001 这是现在的相关代码 Private Sub CommandButton3_Click() ' ===== 性能监控 ===== Dim startTime As Double: startTime = Timer Dim memUsage As Long: memUsage = GetMemoryUsage ' ===== 安全设置 ===== Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False On Error GoTo ErrorHandler ' ===== 分块处理设置 ===== Const CHUNK_SIZE As Long = 5000 ' 每批处理5000行 Dim totalRows As Long, processed As Long Dim srcSheet As Worksheet, scheSheet As Worksheet Set srcSheet = ThisWorkbook.Sheets("Bugzilla") Set scheSheet = ThisWorkbook.Sheets("schedule") totalRows = srcSheet.cells(srcSheet.rows.Count, "A").End(xlUp).row - 1 ' 减标题行 ' ===== 分块处理主循环 ===== Dim chunkStart As Long ' 显式声明为Long Dim chunkEnd As Long ' 显式声明为Long For chunkStart = 2 To totalRows Step CHUNK_SIZE ' 使用工作表函数时添加类型转换 chunkEnd = CLng(Application.Min( _ chunkStart + CHUNK_SIZE - 1, _ totalRows + 1 _ )) ' 进度显示 UpdateProgress "处理中: " & chunkStart & "-" & chunkEnd, chunkStart / totalRows ' 核心处理 - 添加类型转换确保参数匹配 ProcessDataChunk srcSheet, scheSheet, CLng(chunkStart), CLng(chunkEnd) ' 内存释放 DoEvents processed = processed + (chunkEnd - chunkStart + 1) Next chunkStart Cleanup: ' ===== 恢复设置 ===== Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ' ===== 性能报告 ===== Dim timeElapsed As Double: timeElapsed = Timer - startTime Dim memDelta As Long: memDelta = GetMemoryUsage - memUsage MsgBox "处理完成!" & vbCrLf & _ "总行数: " & totalRows & vbCrLf & _ "耗时: " & Format(timeElapsed, "0.00") & "秒" & vbCrLf & _ "内存增量: " & Format(memDelta / 1024, "#,##0") & "KB", _ vbInformation Exit Sub ErrorHandler: MsgBox "错误 " & Err.Number & ": " & Err.Description & vbCrLf & _ "发生在区块: " & chunkStart & "-" & chunkEnd, vbCritical Resume Cleanup End Sub ' ===== 分块处理核心函数 ===== Private Sub ProcessDataChunk(src As Worksheet, sche As Worksheet, startRow As Long, endRow As Long) ' === 添加参数类型验证 === If Not IsNumeric(startRow) Or Not IsNumeric(endRow) Then Err.Raise 13, "ProcessDataChunk", "行号必须是数字类型" End If ' 转换为Long确保类型安全 startRow = CLng(startRow) endRow = CLng(endRow) If VarType(startRow) <> vbLong Then Err.Raise 13, "ProcessDataChunk", "startRow 必须是Long类型" End If ' === 创建字典(添加类型转换) === Dim dict As Object Set dict = CreateObject("Scripting.Dictionary") dict.CompareMode = vbTextCompare ' 加载schedule数据到字典(仅当前区块相关ID) Dim lastScheRow As Long: lastScheRow = sche.cells(sche.rows.Count, "A").End(xlUp).row If lastScheRow >= 2 Then Dim scheData As Variant scheData = sche.Range("A2:A" & lastScheRow).value For i = 1 To UBound(scheData, 1) If Not IsEmpty(scheData(i, 1)) Then dict(scheData(i, 1)) = i + 1 ' 存储行号 End If Next i End If ' 批量读取源数据区块 Dim srcData As Variant srcData = src.Range("A" & startRow & ":I" & endRow).value ' === 创建更新数组(7列对应B-H) === Dim updateData() As Variant ReDim updateData(1 To UBound(srcData, 1), 1 To 7) ' 记录需要更新的行索引 Dim updateRows() As Long ReDim updateRows(1 To UBound(srcData, 1)) Dim updateCount As Long: updateCount = 0 ' === 修复1:统一字典键类型 === For i = 1 To UBound(scheData, 1) If Not IsEmpty(scheData(i, 1)) Then ' 统一转换为字符串键 dict(CStr(scheData(i, 1))) = i + 1 End If Next i ' === 修复1:增强日期安全转换 === For i = 1 To UBound(srcData, 1) If Not IsEmpty(srcData(i, 1)) Then currentID = CStr(srcData(i, 1)) If dict.Exists(currentID) Then updateCount = updateCount + 1 updateRows(updateCount) = i ' 使用增强型安全赋值 updateData(updateCount, 1) = SafeAssign(srcData(i, 2)) ' B updateData(updateCount, 2) = SafeAssign(srcData(i, 3)) ' C updateData(updateCount, 3) = SafeDateAssign(srcData(i, 8)) ' D updateData(updateCount, 4) = SafeDateAssign(srcData(i, 9)) ' E updateData(updateCount, 5) = SafeAssign(srcData(i, 4)) ' F updateData(updateCount, 6) = SafeAssign(srcData(i, 5)) ' G updateData(updateCount, 7) = SafeAssign(srcData(i, 6)) ' H End If End If Next i ' === 批量更新现有行 === If updateCount > 0 Then ' 调整数组大小为实际更新行数 ReDim Preserve updateData(1 To updateCount, 1 To 7) ' 获取目标行号(字典中存储的行号) Dim targetRows() As Long ReDim targetRows(1 To updateCount) For j = 1 To updateCount currentID = CStr(srcData(updateRows(j), 1)) targetRows(j) = dict(currentID) Next j ' 批量更新(每列单独处理) For col = 1 To 7 For j = 1 To updateCount sche.cells(targetRows(j), col + 1).value = updateData(j, col) Next j Next col ' 获取目标行号时检查重复ID Dim uniqueCheck As Object Set uniqueCheck = CreateObject("Scripting.Dictionary") For j = 1 To updateCount currentID = CStr(srcData(updateRows(j), 1)) targetRow = dict(currentID) ' 检查是否重复处理同一行 If Not uniqueCheck.Exists(targetRow) Then uniqueCheck.Add targetRow, True targetRows(j) = targetRow Else ' 记录重复ID警告 Debug.Print "警告: 重复ID " & currentID & " 在行 " & targetRow End If Next j End If ' 批量写入更新数据 If newRows > 0 Then sche.Range("B" & lastScheRow + 1 & ":H" & lastScheRow + newRows).value = updateData End If End Sub ' === 新增通用安全赋值函数 === Private Function SafeAssign(inputVal As Variant) As Variant If IsError(inputVal) Then SafeAssign = "ERROR#" ' 处理错误值 ElseIf VarType(inputVal) = vbEmpty Then SafeAssign = "" Else SafeAssign = inputVal End If End Function ' === 增强日期安全转换 === Private Function SafeDateAssign(inputVal As Variant) As Variant If IsError(inputVal) Then SafeDateAssign = "" ' 清除错误值 Exit Function End If If IsDate(inputVal) Then SafeDateAssign = CDate(inputVal) ElseIf IsNumeric(inputVal) Then ' 处理Excel日期序列号 If inputVal > 0 And inputVal < 50000 Then SafeDateAssign = CDate(inputVal) Else SafeDateAssign = "" End If ElseIf VarType(inputVal) = vbString Then On Error Resume Next SafeDateAssign = CDate(inputVal) If Err.Number <> 0 Then ' 尝试解析常见日期格式 If IsDate(Replace(inputVal, "/", "-")) Then SafeDateAssign = CDate(Replace(inputVal, "/", "-")) Else SafeDateAssign = "" End If End If On Error GoTo 0 Else SafeDateAssign = "" End If End Function ' ===== 内存监控函数 ===== Private Function GetMemoryUsage() As Long Dim proc As Object Set proc = GetObject("winmgmts:\\.\root\cimv2:Win32_Process.Handle=" & CreateObject("WScript.Shell").Exec("mshta.exe").ProcessId) GetMemoryUsage = proc.WorkingSetSize End Function ' === 新增日期安全转换函数 === Private Function ConvertToDate(inputVal As Variant) As Variant If IsDate(inputVal) Then ConvertToDate = CDate(inputVal) ElseIf IsNumeric(inputVal) Then ConvertToDate = CDate(inputVal) ElseIf VarType(inputVal) = vbString Then On Error Resume Next ConvertToDate = CDate(inputVal) If Err.Number <> 0 Then ConvertToDate = "" ' 转换失败返回空 End If On Error GoTo 0 Else ConvertToDate = "" End If End Function ' ===== 进度显示函数 ===== Private Sub UpdateProgress(msg As String, percent As Single) ' 状态栏显示 Application.StatusBar = msg & " | " & Format(percent, "0%") ' 可选:添加进度条窗体 ' 大型数据集建议使用UserForm显示图形进度 End Sub ' === 优化后的超链接添加函数 === Private Sub AddHyperlinksEnhanced(ws As Worksheet, startRow As Long, endRow As Long) On Error Resume Next Dim i As Long Dim baseURL As String baseURL = "http://bugzilla.tp-link.com/show_bug.cgi?id=" For i = startRow To endRow If ws.cells(i, 1).value <> "" Then ws.Hyperlinks.Add _ Anchor:=ws.cells(i, 1), _ Address:=baseURL & ws.cells(i, 1).value, _ TextToDisplay:=ws.cells(i, 1).value End If Next i End Sub
最新发布
08-13
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值