Yoo趣儿

Yoo趣儿 › 操作系统 › Windows › （已解决。感谢 redyear2026！）关于修改扩展名的VBS代 ...

（已解决。感谢 redyear2026！）关于修改扩展名的VBS代码求助

查看 284|回复 29
作者：redyear2026   
   
最近刷到一个更改扩展名的VBS文件，觉得挺不错的。如果能多个下拉菜单，设置一些常用的扩展名，既可以直接选用下拉菜单中的扩展名，也可以自己填写扩展名，就更完美了。

[color=]对我来说，那俺面而去的神啊，难！难！难！
[color=]对万能的坛友，就是小菜一碟！

原代码如下：
[ol]'重命名后缀 By 依梦琴瑶
On Error Resume Next
Dim oArgs, File, fso, OldExt, NewExt, WSHShell
Set oArgs = WScript.Arguments
Set WSHShell = WScript.CreateObject("WScript.Shell")
If oArgs.Count  1 Then
    MsgBox  "请不要双击执行此脚本。",48+4096,"警告"
    WScript.Quit
End If
File = oArgs(0)
Set fso = CreateObject("Scripting.FileSystemObject")
OldExt = fso.GetExtensionName(File)
    NewExt=InputBox("当前文件后缀名：" & OldExt,"请输入新的后缀名")
    If len(NewExt) > 0 Then
        fso.GetFile(File).Name = fso.GetBaseName(File) & "." & NewExt
        WSHShell.Popup "已成功修改扩展名，请注意查收！", 1, "操作成功", vbInformation
        Set WSHShell = Nothing
    End If[/ol]复制代码
[color=]   
[color=]解决方案：特别感谢
redyear2026，也感谢其它热心帮助的朋友。

[color=]   
1、将下面的代码复制并保存为
[color=]ANSI
格式的 hta 文件，命名为“
[color=]修改文件扩展名.hta
”，放于System32中（可以自己改路径及名称）

[ol]
【更改文件扩展名】
自定义扩展名:

扩展名选项:
  去除扩展名
  7z
  ahk
  bat
  cmd
  dll
  exe
  html
  ini
  inf
  jpeg
  lua
  mhtml
  reg
  rar
  tst
  vbs
  xml
  zip

[/ol]复制代码  2、导入注册表，生成右键菜单：（路径图标自己改）
[ol]Windows Registry Editor Version 5.00
[HKEY_LOCAL_MACHINE\PE-SOFT\Classes\*\shell\修改文件扩展名]
"icon"="X:\\Program Files\\Other\\text\\MoreSoft.dll,39"
@="快速修改该文件扩展名(&Z)"
[HKEY_LOCAL_MACHINE\PE-SOFT\Classes\*\shell\修改文件扩展名\command]
;;@="cmd.exe /c start X:\\test\\test.hta \"%L\""
@="pecmd Exec !X:\\Windows\\System32\\修改文件扩展名.hta \"%L\""[/ol]复制代码

扩展名, 文件扩展名, 代码

相关帖子

redyear2026
OP
  
   
直接去问依(梦琴瑶)神。不过vbs应该没有这个能力，需要别的语言了。
coolwu   
如果能够实现，确实完美。
等大神出手
wcz328628706   
   
[分享] 右键添加：修改后缀   看看对你有没有用

redyear2026
OP
  
问题是这也快不到哪去啊。。。
又不能使用热键
还得菜单里再次找寻
真的体现不出多方便啊。
gaohd   
直接复制下面全部代码，保存为 改扩展名.vbs 即可使用：
[ol]'重命名后缀 增强版：下拉菜单 + 手动输入 / 优化升级
On Error Resume Next
Dim oArgs, File, fso, OldExt, NewExt, WSHShell, objIE
Set oArgs = WScript.Arguments
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
' 检查是否拖拽文件
If oArgs.Count  1 Then
    MsgBox "请拖拽一个文件到该脚本上执行！", 48 + 4096, "警告"
    WScript.Quit
End If
File = oArgs(0)
OldExt = fso.GetExtensionName(File)
' ===================== 常用扩展名列表（可自行增删）=====================
Const ExtList = "txt,mp4,jpg,png,mp3,zip,rar,pdf,docx,xlsx,pptx,html,bat,vbs"
' ======================================================================
' 创建带下拉框的输入窗口
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate "about:blank"
objIE.ToolBar = False
objIE.StatusBar = False
objIE.Width = 400
objIE.Height = 220
objIE.Left = 200
objIE.Top = 200
objIE.Document.Title = "修改文件扩展名"
' 构建界面HTML
With objIE.Document.Body
    .Style.Background = "#f0f0f0"
    .Style.Font = "14px 微软雅黑"
    .InnerHTML = "" & _
    "当前文件扩展名：" & OldExt & "
" & _
    "选择或输入新扩展名：
" & _
    "
" & _
    "
" & _
    "" & _
    ""
    ' 填充下拉选项
    Dim arrExt, i
    arrExt = Split(ExtList, ",")
    For i = 0 To UBound(arrExt)
        Set opt = .ParentWindow.document.createElement("OPTION")
        opt.Text = arrExt(i)
        objIE.Document.getElementById("selExt").options.add(opt)
    Next
End With
' 脚本逻辑
objIE.Document.ParentWindow.window.setInterval "if(document.activeElement.tagName!='HTML'&&document.activeElement.tagName!='BODY'){document.getElementById('selExt').blur();}", 100
objIE.Document.ParentWindow.ok = GetRef("OKClick")
objIE.Document.ParentWindow.cancel = GetRef("CancelClick")
objIE.Visible = True
' 等待用户操作
Do While objIE.Visible
    WScript.Sleep 100
Loop
Sub OKClick()
    NewExt = Trim(objIE.Document.getElementById("txtExt").Value)
    If NewExt = "" Then
        NewExt = Trim(objIE.Document.getElementById("selExt").Value)
    End If
    objIE.Quit()
    Set objIE = Nothing
    If Len(NewExt) > 0 Then
        fso.GetFile(File).Name = fso.GetBaseName(File) & "." & NewExt
        WSHShell.Popup "修改成功！新扩展名：" & NewExt, 2, "成功", 64
    End If
    WScript.Quit
End Sub
Sub CancelClick()
    objIE.Quit()
    Set objIE = Nothing
    WScript.Quit
End Sub
[/ol]复制代码
happyhour520   
来看看
redyear2026
OP
  

a66 发表于 2026-3-28 12:11
直接复制下面全部代码，保存为 改扩展名.vbs 即可使用：
好像要保存为ANSI才能正常运行此代码，否则会出错。
运行后，弹出一个提示，但无法使用。
redyear2026
OP
  

yyz2191958 发表于 2026-3-28 11:55
[分享] 右键添加：修改后缀   看看对你有没有用
谢谢！这个已有，但不方便，后缀名太多了。
redyear2026
OP
  

xmzhqw 发表于 2026-3-28 12:42
好像要保存为ANSI才能正常运行此代码，否则会出错。
运行后，弹出一个提示，但无法使用。
确实是这样
下一页 »
123下一页
返回列表
您需要登录后才可以回帖 登录 | 立即注册

AD1

热门主题

热门板块

问与答分享发现分享创造奇思妙想分享邀请码商业推广优惠信息PythonPHPJavaJavaScriptNode.jsGo语言C++HTML

公告

标签|小黑屋|Yoo趣儿

GMT+8, 2026-3-31 03:38 , Processed in 0.136641 second(s), 12 queries , Gzip On, MemCached On.

Powered by Discuz! X3.2

The happiest thing in the world is to strive for an ideal.