代码：createobject("sapi.spvoice").speak "//编辑要说的话"

 

 

小编自己是学编程的，发声代码这个第一次遇到。现在想实现将vbs发声代码加入到电脑启动中，实现当电脑启动，自动将语言播放......

 

相信各位大神都用过酷狗音乐，酷狗音乐打开的时候就会有这样一句话“hello，酷狗”

 

请各位大大帮帮忙，告诉我实现代码开机发声的路径，在此谢过~

当前位置:我的异常网» VB » vba代码改成vbs,该怎么解决
vba代码改成vbs,该怎么解决
www.myexceptions.net  网友分享于：2013-01-30  浏览：58次
vba代码改成vbs
我有一段写在Excel中的VBA代码，现在需要从Excel独立，写成vbs。
用vbs浏览文件名，打开文件的代码已经写好。现在只需要把vba代码中的on   error   resume   next，goto等语句换掉。
原VBA代码(可用)：
Private   Sub   CommandButton1_Click()
On   Error   Resume   Next
Dim   fill()
ReDim   fill(1   To   ActiveSheet.UsedRange.Columns.Count)
For   i   =   ActiveSheet.UsedRange.Rows.Count   To   1   Step   -1
DoEvents
insert_count   =   0
last_insert   =   0
For   y   =   1   To   ActiveSheet.UsedRange.Columns.Count
n   =   0
If   Len(Cells(i,   y))    <   1   Then   GoTo   g_next1
If   last_insert    <>    y   Then   i_count   =   insert_count
s_string   =   0
s_string   =   WorksheetFunction.Find( "||| ",   Cells(i,   y),   1)
If   s_string   =   0   And   Len(Cells(i,   y).Value)   >    0   Then   fill(y)   =   True   Else   fill(y)   =   False
Do   While   True
s_string   =   0
s_string   =   WorksheetFunction.Find( "||| ",   Cells(i,   y),   1)
If   s_string   =   0   Then   GoTo   g_next1
If   last_insert   =   0   Then
Rows(i   +   n   +   1).Insert
insert_count   =   insert_count   +   1
last_insert   =   y
Else
If   last_insert   =   y   Then
Rows(i   +   n   +   1).Insert
insert_count   =   insert_count   +   1
last_insert   =   y
Else
文章评论

【VBS】实用链接指南
Hello World！
序
1、目的
2、需求分析
3、举例
4、思路
一、上手编程语言初步
（一）Visual Basic快速入门
（二）简洁的代码编辑器推荐
1. Sublime Text 下载
2. VB代码语法高亮设置
3. 中文乱码或报错解决
二、创建最简单的窗口
（一）教你用怎么vbs写一个简易的对话框
（二）vbs输入框和消息框
（三）VBS中InputBox函数的返回值使用技巧
三、常见问题与操作
（一）VBS脚本一行代码太长，使用换行符
（二）vbs执行显示中文乱码怎么办
四、APIs
（一）大佬的博客
1. 测试开发技术—VBS随笔
（二）字符串操作
1. VBS中常见字符串操作函数
2. vbs vbscript 中的回车换行符号 等特殊字符
（三）数组
（四）文件文件夹操作
1. VBS对文件文件夹操作的例子
五、产品其他完善度相关
（一）“正规软件外形”
1、怎么修改桌面快捷方式图标
2、怎样把一般的图片变成图标格式
后记:小项目现状
v1.0 纯粹面向过程编程源码
v2.0 纯粹面向过程编码，良好函数抽象封装
1、架构图
2、源码
v4.0 自动化获取vbs文件所在文件夹目录层次结构，代替了手动输入文件夹名称数组的硬编码（我的同事正在使用这一个比较稳定的版本）
v4.1 在v4.0基础上，增加了夸奖人的随机形容词功能
v5.0 增加了自动获取并显示文件夹名称结构层次的显示功能


注意：仅限Windows系统！

Hello World！
桌面新建个txt文本，打开写上如下内容：
msgbox "Hello World!"

保存，文件后缀再改为“vbs”即可执行，

（如果没有显示后缀名，自行百度解决）

双击运行，

完美的Windows系统上的迷你小窗口！

内容就是：

Hello World！

简单的要命，有木有，哈哈哈！

序
1、目的
Windows系统上用最简单的方法直接创建窗口程序，

需要有常见编程语言的语法基础。

我之前没有学过vbs，

但本身是软件工程专业科班生，

具有一定的其他多种语言的编程基础。

先有实践的问题，再想解决问题，而出现的此文章，

并不是凭空捏造的问题与文章及程序。
2、需求分析
一个盘里的文件名字开头全有10以内数字编号开头，

要求弹出窗口输入一串数字编号，

便可以打开指定文件夹。

（程序是小事，

实际上如何给每个人电脑上所有文件夹合适的分类

才是根本问题！）
3、举例
弹出交互窗口输入“122”，点击确认，

即可打开文件夹地址为：

“E:\工作\1、人事\2、培训\2、实习期”。

其中，后面的顿号和汉字是任意的，

只关注文件名前面的数字即可。
4、思路
以需求的解决逻辑和一步步遇见的问题为思路，

去逐步百度搜索。

以下提供的所有的链接，

都是只要解决问题就可以，

几乎都不用全部浏览。
有编程基础的会上手的很快。

一、上手编程语言初步
（一）Visual Basic快速入门
https://blog.csdn.net/achenyuan/article/details/83987056
如果有其他编程语言基础，这个不用看，当做语法工具书查阅即可。
（二）简洁的代码编辑器推荐

Sublime Text 3

我一开始用的Notepad++，

可惜玩了半天突然不支持VB的语法高亮了？？？

又问度娘搜到了这个，非常棒！

1. Sublime Text 下载
地址：https://www.sublimetext.com/
2. VB代码语法高亮设置
（后来我又找不到VB了，用ASP也行）


3. 中文乱码或报错解决
sublime text 3支持GBK编码

https://www.cnblogs.com/wxdblog/p/7992854.html
二、创建最简单的窗口
（一）教你用怎么vbs写一个简易的对话框
https://jingyan.baidu.com/article/22fe7cedd478133002617f23.html

注意： 中文可能报错或乱码，粗暴解决，用英文即可。
（二）vbs输入框和消息框
https://jingyan.baidu.com/article/9f63fb91492403c8410f0e4b.html
（三）VBS中InputBox函数的返回值使用技巧
https://www.jb51.net/article/26809.htm
三、常见问题与操作
（一）VBS脚本一行代码太长，使用换行符
http://www.51testing.com/html/85/87885-17546.html
（二）vbs执行显示中文乱码怎么办
https://jingyan.baidu.com/article/95c9d20d81c67dad4f756111.html
四、APIs
（一）大佬的博客
1. 测试开发技术—VBS随笔
https://www.cnblogs.com/jinjiangongzuoshi/category/491750.html

其中的：VBS基础篇 - 对象(1) - Class对象

用来学习面向对象形式的写法还挺不错的！！！
（二）字符串操作
1. VBS中常见字符串操作函数
https://www.jb51.net/article/159913.htm
2. vbs vbscript 中的回车换行符号 等特殊字符
https://www.dazhuanlan.com/2020/06/02/5ed645c962d9a/
（三）数组
动态数组：https://www.jb51.net/article/141114.htm
（四）文件文件夹操作
1. VBS对文件文件夹操作的例子
http://www.360doc.com/content/14/0606/15/219800_384287850.shtml

（五）vbs如何获取当前时间日期

http://www.jquerycn.cn/a_9237
五、产品其他完善度相关
将自己的vbs文件放到磁盘中合适的文件中，

然后右击发送到桌面快捷方式。

然后桌面就有快捷方式了，

它的图标是可以随意改变的，

可用其他图片，或自行设计图片。
详细步骤参考如下：
（一）“正规软件外形”
1、怎么修改桌面快捷方式图标
百度经验链接
2、怎样把一般的图片变成图标格式
推荐这个：转转大师，在线的，链接如下：

http://pdftoword.55.la/img2icon/
后记:小项目现状
v1.0 纯粹面向过程编程源码
' 
' 候帅洲
'
' 手机和微信：175 3102 3301
'
' 此小项目CSDN详解博客地址：https://blog.csdn.net/weixin_44591035/article/details/113667614
'
'
'
' 1、需求分析
' 一个盘里的文件名字开头全有10以内数字编号开头，
' 要求弹出窗口输入一串数字编号，便可以打开指定文件夹。
' 
' 2、举例
' 弹出交互窗口输入“122”，点击确认，
' 即可打开文件夹地址为：
' “E:\工作\1、人事\2、培训\2、实习期”。
' 其中，后面的顿号和汉字是任意的，
' 只关注文件名前面的数字即可。
' 
' 3、目前进度
' 以硬编码实现了第一个实用版本（v1.0：纯粹面向过程编码)
' 已经可以投入现实使用了，一位美女同事已经用上了
' 以后逐渐慢慢迭代版本吧


' 一、初始化与主窗口创建

' （一）定义变量与初始化

' 1. 定义和初始化目录结构
' （1）先硬编码根目录
dim strRootDir
strRootDir = "E:\工作\"

' （2）先硬编码所有分目录
dim idDirArr
idDirArr = Array( _
    "1", "1、人事", _
    "2", "2、顾问", _
    "3", "3、个人", _
    "4", "4、待整理", _
    _
    "11", "1、招聘", _
    "12", "2、培训", _
    "13", "3、制度", _
    "14", "4、活动", _
    _
    "111", "1、专业知识", _
    "112", "2、招聘简章", _
    "113", "3、简历", _
    "114", "4、统计", _
    "115", "5、素材", _
    "116", "6、其他资料", _
    _
    "120", "0、按类型分类汇总", _
    "121", "1、七天入职新员工培训", _
    "122", "2、实习期", _
    "123", "3、其他机构" _
)

' 2. 定义和初始化各类窗口标题
dim mainWinTitle, tipsWinTitle
' （1）主窗口标题
mainWinTitle = "博瑞智（邯郸）家庭教育服务中心-孙文"
' （2）提示窗口标题
tipsWinTitle = "来自候帅洲的温馨提示"

' 3. 定义和初始化各种健壮性处理提示用语
dim strTipsTemp0, strTipsTemp1, strTipsTemp2, strTipsTemp3
' （1）提示位置：一、（二）
strTipsTemp0 = vbCrLf + "世界上最漂亮的孙文！" + vbCrLf _
                + vbCrLf + "请输入要打开的文件夹编号吧！" 
' （2）提示位置：二、（二）
strTipsTemp1 = "您没有输入任何编号哦！！！"  
' （3）提示位置：二、（三）
strTipsTemp2 = "您的输入不是纯数字哦！！！"
' （4）提示位置：三、（二）
strTipsTemp3 = "您的输入的编号没有对应的文件夹哦！！！"

' （二）创建交互输入框
dim id
id = inputbox(strTipsTemp0,mainWinTitle)



' 二、健壮性处理

' （一）如果inputbox返回值为Empty，即用户点击的是“取消”；
If IsEmpty(id) Then  
    WScript.Quit 
End If

' （二）输入框内容为空时直接点击“确定”；
If Len(id) = 0 Then  
    msgbox strTipsTemp1, vbokcancel + vbInformation, tipsWinTitle
    WScript.Quit
End If

' （三）id有字符但为非纯数字时
If Not isnumeric(id) Then
    msgbox strTipsTemp2, vbokcancel + vbInformation, tipsWinTitle
    WScript.Quit
end if



' 三、主逻辑处理
' （id为纯数字时）
' （一）目录结构字典的定义和初始化
' 将目录结构“id-目录”放入键值对字典对象——idDirDict
dim idDirDict, i
Set idDirDict = WSH.CreateObject("Scripting.Dictionary")
For i = 0 to UBound(idDirArr)
    idDirDict.Add idDirArr(i), idDirArr(i + 1)
    i = i + 1
Next

' （二）健壮性处理
' 判断指定的key是否存在
If Not idDirDict.Exists(id) Then
    msgbox strTipsTemp3, vbokcancel + vbInformation, tipsWinTitle
    WScript.Quit
End If  

' （三）最终处理
' 1. 确定目录存在后，拼接绝对目录
dim strFinalDir
For i = 0 to Len(id) - 1
    strFinalDir = strFinalDir + "\" + idDirDict.Item(left(id, i + 1))
Next
' 2. 打开目标文件夹，结束
Dim ObjWS
Set ObjWS = WScript.CreateObject("wscript.shell")
ObjWS.run strRootDir + strFinalDir


v2.0 纯粹面向过程编码，良好函数抽象封装
1、架构图

2、源码
' 
' 候帅洲
'
' 手机和微信：175 3102 3301
'
' 此小项目CSDN详解博客地址：https://blog.csdn.net/weixin_44591035/article/details/113667614
'
'
' 1、需求分析
' 一个盘里的文件名字开头全有10以内数字编号开头，
' 要求弹出窗口输入一串数字编号，便可以打开指定文件夹。
' 
' 2、举例
' 弹出交互窗口输入“122”，点击确认，
' 即可打开文件夹地址为：
' “E:\工作\1、人事\2、培训\2、实习期”。
' 其中，后面的顿号和汉字是任意的，
' 只关注文件名前面的数字即可。
' 
' 3、目前进度
' 以硬编码实现的第二个版本，v2
' 还是纯粹面向过程编码,但都已良好封装函数,
' 函数抽象合适,函数之间有良好简洁且固定的层次关系
' 以后逐渐慢慢迭代版本吧
' 

' ' 程序入口
' ' 马克思写法，逻辑在物质中辩证存在，唯物主义辩证法
' Call MainWin()

' ' 一、主窗口
' ' 主窗口总函数
' Sub MainWin() 
'     dim id, mainWinTitle, mainWinTips
'     Call Init_MainWin(mainWinTitle, mainWinTips)
'     ' 创建交互输入框
'     id = inputbox(mainWinTips, mainWinTitle)
'     Call Robust_MainWin(id)
'     Call MainLogic(id)
' End Sub

' 程序入口
' 黑格尔写法，一切都在宇宙的逻辑之中，唯心主义
Call MainLogic(MainWin())

' 一、主窗口
' 主窗口总函数
Function MainWin() 
    dim id, mainWinTitle, mainWinTips
    Call Init_MainWin(mainWinTitle, mainWinTips)
    ' 创建交互输入框
    id = inputbox(mainWinTips, mainWinTitle)
    Call Robust_MainWin(id)
    MainWin = id
End Function

' （一）初始化主窗口提示内容
Sub Init_MainWin(mainWinTitle, mainWinTips)
    dim enterpriseName ,userName, userAdj, menAdj, womenAdj
    enterpriseName = "博瑞智（邯郸）家庭教育服务中心"
    userName = "孙文"
    menAdj = "世界上最帅的"
    womenAdj = "世界上最漂亮的"
    userAdj = womenAdj
    ' 主窗口标题
    mainWinTitle = enterpriseName & "-" & userName
    ' 提示用语
    mainWinTips = vbCrLf & userAdj & userName & vbCrLf _
                    + vbCrLf + "请输入要打开的文件夹编号吧！"
End Sub

' （二）主窗口健壮性处理
Sub Robust_MainWin(id)
    dim tipsWinTitle, tipsWinTips1, tipsWinTips2
    Call Init_Robust_MainWin(tipsWinTitle, tipsWinTips1, tipsWinTips2)
    
    ' 1. 如果inputbox返回值为Empty，即用户点击的是“取消”；
    If IsEmpty(id) Then  
        WScript.Quit 
    End If

    ' 2. 输入框内容为空时直接点击“确定”；
    If Len(id) = 0 Then  
        msgbox tipsWinTips1, vbokcancel + vbInformation, tipsWinTitle
        WScript.Quit
    End If

    ' 3. id有字符但为非纯数字时
    If Not isnumeric(id) Then
        msgbox tipsWinTips2, vbokcancel + vbInformation, tipsWinTitle
        WScript.Quit
    end if
End Sub

' （三）初始化主窗口健壮性处理提示窗口内容
Sub Init_Robust_MainWin(tipsWinTitle, tipsWinTips1, tipsWinTips2)
    ' 1. 初始化主窗口健壮性处理提示窗口标题
    tipsWinTitle = "来自候帅洲的温馨提示"

    ' 2. 初始化主窗口健壮性处理提示用语
    ' （1）提示位置：一、（三）2.
    tipsWinTips1 = "您没有输入任何编号哦！！！"  
    ' （2）提示位置：一、（三）3.
    tipsWinTips2 = "您的输入不是纯数字哦！！！"
End Sub



' 二、主逻辑
' 主逻辑总函数
Sub MainLogic(id)
    dim strRootDir, idDirDict
    Call Init_MainLogic(strRootDir, idDirDict)
    Call Robust_MainLogic(id, idDirDict)
    
    ' 1. 确定目录存在后，拼接绝对目录
    ' (这里的确定的前提是，硬编码的目录结构映射是真实的。)
    dim strFinalDir, i
    For i = 0 to Len(id) - 1
        strFinalDir = strFinalDir + "\" + idDirDict.Item(left(id, i + 1))
    Next
    
    ' 2. 打开目标文件夹，结束
    Dim ObjWS
    Set ObjWS = WScript.CreateObject("wscript.shell")
    ObjWS.run strRootDir + strFinalDir
End Sub

' （一）初始化主逻辑内容
Sub Init_MainLogic(strRootDir, idDirDict)
    ' 1、硬编码目录结构
    ' （1）先硬编码根目录
    strRootDir = "E:\ID之道\工作"

    ' （2）先硬编码所有分目录
    dim idDirArr
    idDirArr = Array( _
        "1", "1、人事", _
        "2", "2、顾问", _
        "3", "3、个人", _
        "4", "4、待整理", _
        _
        "11", "1、招聘", _
        "12", "2、培训", _
        "13", "3、制度", _
        "14", "4、活动", _
        _
        "111", "1、专业知识", _
        "112", "2、招聘简章", _
        "113", "3、简历", _
        "114", "4、统计", _
        "115", "5、素材", _
        "116", "6、其他资料", _
        _
        "120", "0、按类型分类汇总", _
        "121", "1、七天入职新员工培训", _
        "122", "2、实习期", _
        "123", "3、其他机构" _
    )
    
    ' （id为纯数字时）
    ' 2、目录结构字典的初始化
    ' 将目录结构“id-目录”放入键值对字典对象——idDirDict
    dim i
    Set idDirDict = WSH.CreateObject("Scripting.Dictionary")
    For i = 0 to UBound(idDirArr)
        idDirDict.Add idDirArr(i), idDirArr(i + 1)
        i = i + 1
    Next    
End Sub

' （二）主逻辑健壮性处理
Sub Robust_MainLogic(id, idDirDict)
    dim tipsWinTitle, tipsWinTips
    Call Init_Robust_MainLogic(tipsWinTitle, tipsWinTips)
    
    ' 判断指定的key是否存在
    If Not idDirDict.Exists(id) Then
        msgbox tipsWinTips, vbokcancel + vbInformation, tipsWinTitle
        WScript.Quit
    End If  
End Sub

' （三）初始化主逻辑健壮性处理提示窗口内容
Sub Init_Robust_MainLogic(tipsWinTitle, tipsWinTips)
    ' 1. 初始化主逻辑健壮性处理提示窗口标题
    tipsWinTitle = "来自候帅洲的温馨提示"
    ' 2. 初始化主逻辑健壮性处理提示用语
    tipsWinTips = "您的输入的编号没有对应的文件夹哦！！！"
End Sub


v4.0 自动化获取vbs文件所在文件夹目录层次结构，代替了手动输入文件夹名称数组的硬编码（我的同事正在使用这一个比较稳定的版本）
(汉字都抽离都了程序最前面，以便之后的封装设置选项，大家改个汉字的描述就成了属于自己的程序了)
' 
' 候帅洲
'
' 手机和微信：175 3102 3301
'
' 此小项目CSDN详解博客地址：https://blog.csdn.net/weixin_44591035/article/details/113667614
'
'
' 1、需求分析
' 一个盘里的文件名字开头全有10以内数字编号开头，
' 要求弹出窗口输入一串数字编号，便可以打开指定文件夹。
' 
' 
' 2、举例
' 弹出交互窗口输入“122”，点击确认，
' 即可打开文件夹地址为：
' “E:\工作\1、人事\2、培训\2、实习期”。
' 其中，后面的顿号和汉字是任意的，
' 只关注文件名前面的数字即可。
' 
' 
' 3、目前进度
' 第四个版本，v4
' 面向对象形式改造，进一步的封装变换
' 加入自动查找抽离文件id并匹配
'

' ——————————————————————————————————————————————————————————————————
' 
'···························！！！注意！！！！！！
' 
' 目前算法编码严格要求两个准则：
' 1、每个文件夹数字编号必须是文件名称的第一个字符并只能用一位阿拉伯数字表示
' 2、每个文件夹数字编号与文件夹名的分割符号 
'   紧跟在数字后面且只有一个，且文件夹名称只能含一个
'   （目前分隔符为顿号“、”，可改，但不推荐）
' 
' ——————————————————————————————————————————————————————————————————


dim variateValueArr
variateValueArr = Array( _
            "博瑞智（邯郸）家庭教育服务中心", _
            "孙文", _
            "世界上最漂亮的", _
            "请输入要打开的文件夹编号吧！", _
            _
            "来自候帅洲的温馨提示", _
            "您没有输入任何编号哦！！！", _
            "您的输入不是纯数字哦！！！", _
            "您的输入的编号没有对应的文件夹哦！！！", _     
            _
            "、" _
) 

dim variateIDArr
variateIDArr = Array( _
            _
            "111", _
            "112", _
            "113", _
            "114", _
            _
            "211", _
            "212", _
            "213", _
            "221", _      
            _
            "121" _ 
)
dim variateDescribeArr
variateDescribeArr = Array( _
            "enterpriseName", _
            "userName", _
            "userAdj", _
            "inpuIDTips", _
            _
            "tipsWinTitle", _
            "tipsWinTips_ClickOKWhenBlank", _
            "tipsWinTips_ClickOKWhenNotPureNumber", _
            "tipsWinTips_IDNotReal", _  
            _
            "文件夹数字编号与文件夹名的分割符号" _
)

' dim classifiedNumberArr
' classifiedNumberArr = Array(4, 4, 1)

dim gttwMapping
Set gttwMapping = New GTTW_Mapping
gttwMapping.variateIDArr = variateIDArr
gttwMapping.variateDescribeArr = variateDescribeArr
gttwMapping.variateValueArr = variateValueArr
gttwMapping.createMapping()




' 程序入口
' 黑格尔写法，一切都在宇宙的逻辑之中，唯心主义
Call MainLogic(MainWin())

' 一、主窗口
' 主窗口总函数
Function MainWin() 
    dim id, mainWinTitle, mainWinTips
    Call Init_MainWin(mainWinTitle, mainWinTips)
    ' 创建交互输入框
    id = inputbox(mainWinTips, mainWinTitle)
    Call Robust_MainWin(id)
    MainWin = id
End Function

' （一）初始化主窗口提示内容
Sub Init_MainWin(mainWinTitle, mainWinTips) 
    dim enterpriseName  ' variateID = 111
    enterpriseName = gttwMapping.getVariateValue("111")
    dim userName
    userName = gttwMapping.getVariateValue("112")
    dim userAdj
    userAdj = gttwMapping.getVariateValue("113")
    dim inputIDTips
    inputIDTips = gttwMapping.getVariateValue("114")
    
    ' 1. 主窗口标题
    mainWinTitle = enterpriseName & "-" & userName
    ' 2. 提示用语
    mainWinTips = vbCrLf & userAdj & userName & vbCrLf _
                    + vbCrLf + inputIDTips
End Sub

' （二）主窗口健壮性处理
Sub Robust_MainWin(id)
    dim tipsWinTitle, tipsWinTips_ClickOKWhenBlank, tipsWinTips_ClickOKWhenNotPureNumber
    Call Init_Robust_MainWin(tipsWinTitle, tipsWinTips_ClickOKWhenBlank, tipsWinTips_ClickOKWhenNotPureNumber)
    
    ' 1. 如果inputbox返回值为Empty，即用户点击的是“取消”；
    If IsEmpty(id) Then  
        WScript.Quit 
    End If

    ' 2. 输入框内容为空时直接点击“确定”；
    If Len(id) = 0 Then  
        ' msgbox tipsWinTips_ClickOKWhenBlank, vbokcancel + vbInformation, tipsWinTitle
        Call promptWin(tipsWinTips_ClickOKWhenBlank, tipsWinTitle)
        WScript.Quit
    End If

    ' 3. id有字符但为非纯数字时
    If Not isnumeric(id) Then
        ' msgbox tipsWinTips_ClickOKWhenNotPureNumber, vbokcancel + vbInformation, tipsWinTitle
        Call promptWin(tipsWinTips_ClickOKWhenNotPureNumber, tipsWinTitle)
        WScript.Quit
    end if
End Sub

' （三）初始化主窗口健壮性处理提示窗口内容
Sub Init_Robust_MainWin(tipsWinTitle, tipsWinTips_ClickOKWhenBlank, tipsWinTips_ClickOKWhenNotPureNumber)
    ' 1. 初始化主窗口健壮性处理提示窗口标题
    tipsWinTitle = gttwMapping.getVariateValue("211")

    ' 2. 初始化主窗口健壮性处理提示用语
    ' （1）提示位置：一、（三）2.
    tipsWinTips_ClickOKWhenBlank = gttwMapping.getVariateValue("212")
    ' （2）提示位置：一、（三）3.
    tipsWinTips_ClickOKWhenNotPureNumber = gttwMapping.getVariateValue("213")
End Sub



' 二、主逻辑
' 主逻辑总函数
'（id为纯数字时）
' 
' 思路：
' 例如目标文件夹为：str = “E:\工作\2、222\1、开发冷战零撒扥\3、阿森简单 - 副本”
' 
' 解决：
' 直接从str中抽离“213”，然后与id直接比较，一样则直接打开此文件夹



' （一）定义相关变量和初始化并结束整个逻辑链

sub MainLogic(id)

    Dim objFSO, objWS, currentDir, separatorStr
    Set objFSO = CreateObject("Scripting.FileSystemObject") 
    Set objWS = WScript.CreateObject("wscript.shell")
    currentDir = objWS.CurrentDirectory
    separatorStr = gttwMapping.getVariateValue("121")
    Call SearchFolder(currentDir, objFSO, objWS, id, separatorStr)
    
    dim tipsWinTitle
    tipsWinTitle = gttwMapping.getVariateValue("211")
    dim tipsWinTips_IDNotReal
    tipsWinTips_IDNotReal = gttwMapping.getVariateValue("221")
    ' msgbox tipsWinTips_IDNotReal, vbokcancel + vbInformation, tipsWinTitle
    Call promptWin(tipsWinTips_IDNotReal, tipsWinTitle)
end sub




' （二）核心算法函数封装
Sub SearchFolder(folderPath, objFSO, objWS, id, separatorStr)   
    dim objFolder
	Set objFolder=objFSO.GetFolder(folderPath)
	Set SubFolders=objFolder.SubFolders
	If SubFolders.Count = 0 then
		'msgbox "exit search:" & folderPath
		exit Sub
	End If
    
    dim strIDTemp, ss, n, str, index, strTemp
	For Each subFolder In SubFolders
        strIDTemp = subFolder.path     
        ss = Split(strIDTemp, separatorStr, -1)
        n = UBound(ss) - 1
        str = ""
        For i = 0 to n
            strTemp = ss(i)
            index = Len(strTemp)
            str = str & Mid(strTemp, index, 1)
        next
        if StrComp(str, id) = 0 then
            ' msgbox strIDTemp
            Call openDir(strIDTemp, objWS)
            WScript.Quit
        end if
		Call SearchFolder(subFolder.path, objFSO, objWS, id, separatorStr)
	Next
End Sub

' 提示窗口
Sub promptWin(tips, title)
    msgbox tips, vbokcancel + vbInformation, title
End Sub

' 打开文件夹，这里主要是解决了路径带空格报错的问题
Sub openDir(dir, objWS)
    Const vbQuote = """"
    dir = vbQuote & dir & vbQuote
    objWS.run dir
End Sub



' GTTW制作的Mapping核心映射类
' 以程序设计的标准化、规范化、流程化为中心思想
' 最重要的是合适的抽象化
' 
' 此映射类给程序提供模板化设计思想
' 
' 此映射类主要功能：
' 映射所有与现实世界有关的变量
' 让程序设计依赖抽象，而不去依赖具体现实，符合依赖倒置原则
' 并提供可视化设置的数据接口
' 
' 感觉完全可以存到数据库呀！
' 

Class GTTW_Mapping

    ' Key Value Dictionary Variate
    
    ' IDValueDictVar
    ' IVDV  —>  ivdv
    ' （variateIDArr --> variateValueArr）
    ' “ID-值”键值对字典映射变量
    Private m_ivdv

    ' IDDescribeDictVar
    ' IDDV  —>  iddv
    ' （variateIDArr --> variateValueArr）
    ' “ID-描述”键值对字典映射变量
    Private m_iddv 
    
    Private m_variateIDArr  ' 需要主体程序设计的形而上变量的id数组
    Private m_variateValueArr  ' 需要从现实世界获取的变量的值数组
    Private m_variateDescribeArr  ' 需要主体程序设计的形而上变量的描述数组
    Private m_classifiedNumberArr  ' 需要主体程序传入的以上变量数组的分类分组数目数组
 
    ' Initialize事件相当于构造函数
    Private Sub Class_Initialize  ' 当这个类被创建时执行
        ' MsgBox "类开始"
        Set m_ivdv = WSH.CreateObject("Scripting.Dictionary")
        Set m_iddv = WSH.CreateObject("Scripting.Dictionary")
    End Sub
    
    Public Default Function Constructor(variateIDArr, variateDescribeArr, classifiedNumberArr)
        m_variateIDArr = variateIDArr
        m_variateDescribeArr = variateDescribeArr
        m_classifiedNumberArr = classifiedNumberArr
        ' Set Constructor = Me
    End Function
    
    ' 只读只写方法
    Public Property Get ivdv
        ivdv = m_ivdv
    End Property
    
    ' 注意————私有的
    Private Property Let ivdv(new_ivdv)
        m_ivdv = new_ivdv
    End Property 
    
    Public Property Get iddv
        iddv = m_iddv
    End Property
    
    ' 注意————私有的
    Private Property Let iddv(new_iddv)
        m_iddv = new_iddv
    End Property 
     
    Public Property Get variateIDArr
        variateIDArr = m_variateIDArr
    End Property 
    
    Public Property Let variateIDArr(new_variateIDArr)
        m_variateIDArr = new_variateIDArr
    End Property   
    
    Public Property Get variateValueArr
        variateValueArr = m_variateValueArr
    End Property  
    
    ' 注意————之后要改为私有的
    Public Property Let variateValueArr(new_variateValueArr)
        m_variateValueArr = new_variateValueArr
    End Property      
    
    Public Property Get variateDescribeArr
        variateDescribeArr = m_variateDescribeArr
    End Property  
    
    Public Property Let variateDescribeArr(new_variateDescribeArr)
        m_variateDescribeArr = new_variateDescribeArr
    End Property 
    
    Public Property Get classifiedNumberArr
        classifiedNumberArr = m_classifiedNumberArr
    End Property  
    
    Public Property Let classifiedNumberArr(new_classifiedNumberArr)
        m_classifiedNumberArr = new_classifiedNumberArr
    End Property  
    
    ' 建立两个映射
    Public Sub createMapping()
        dim i, n
        n = ubound(m_variateIDArr)
        For i = 0 to n
            m_ivdv.Add m_variateIDArr(i), m_variateValueArr(i)
        Next 
        For i = 0 to n
            m_iddv.Add m_variateIDArr(i), m_variateDescribeArr(i)
        Next 
    End Sub  
    
    ' 以变量id得到相应变量在现实世界的值
    Public Function getVariateValue(variateID)
        getVariateValue = m_ivdv.Item(variateID)
    End Function
    
    ' 以变量id得到相应变量在现实世界的描述
    Public Function getVariateDescribe(variateID)
        getVariateDescribe = m_iddv.Item(variateID)
    End Function
End Class


v4.1 在v4.0基础上，增加了夸奖人的随机形容词功能
（不过，目前形容词库还是硬编码）
' 
' 候帅洲
'
' 手机和微信：175 3102 3301
'
' 此小项目CSDN详解博客地址：https://blog.csdn.net/weixin_44591035/article/details/113667614
'
'
' 1、需求分析
' 一个盘里的文件名字开头全有10以内数字编号开头，
' 要求弹出窗口输入一串数字编号，便可以打开指定文件夹。
' 
' 
' 2、举例
' 弹出交互窗口输入“122”，点击确认，
' 即可打开文件夹地址为：
' “E:\工作\1、人事\2、培训\2、实习期”。
' 其中，后面的顿号和汉字是任意的，
' 只关注文件名前面的数字即可。
' 
' 
' 3、目前进度
' 第四个版本，v4
' 面向对象形式改造，进一步的封装变换
' 加入自动查找抽离文件id并匹配
' 增加了夸奖人的随机形容词功能
'

' ——————————————————————————————————————————————————————————————————
' 
'···························！！！注意！！！！！！
' 
' 目前算法编码严格要求两个准则：
' 1、每个文件夹数字编号必须是文件名称的第一个字符并只能用一位阿拉伯数字表示
' 2、每个文件夹数字编号与文件夹名的分割符号 
'   紧跟在数字后面且只有一个，且文件夹名称只能含一个
'   （目前分隔符为顿号“、”，可改，但不推荐）
' 
' ——————————————————————————————————————————————————————————————————


dim variateValueArr
variateValueArr = Array( _
            "博瑞智（邯郸）家庭教育服务中心", _
            "孙文", _
            "请输入要打开的文件夹编号吧！", _
            _
            "来自候帅洲的温馨提示", _
            "您没有输入任何编号哦！！！", _
            "您的输入不是纯数字哦！！！", _
            "您的输入的编号没有对应的文件夹哦！！！", _     
            _
            "、" _
) 

dim variateIDArr
variateIDArr = Array( _
            _
            "111", _
            "112", _
            "114", _
            _
            "211", _
            "212", _
            "213", _
            "221", _      
            _
            "121" _ 
)
dim variateDescribeArr
variateDescribeArr = Array( _
            "enterpriseName", _
            "userName", _
            "inpuIDTips", _
            _
            "tipsWinTitle", _
            "tipsWinTips_ClickOKWhenBlank", _
            "tipsWinTips_ClickOKWhenNotPureNumber", _
            "tipsWinTips_IDNotReal", _  
            _
            "文件夹数字编号与文件夹名的分割符号" _
)

' dim classifiedNumberArr
' classifiedNumberArr = Array(4, 4, 1)

dim gttwMapping
Set gttwMapping = New GTTW_Mapping
gttwMapping.variateIDArr = variateIDArr
gttwMapping.variateDescribeArr = variateDescribeArr
gttwMapping.variateValueArr = variateValueArr
gttwMapping.createMapping()




' 程序入口
' 黑格尔写法，一切都在宇宙的逻辑之中，唯心主义
Call MainLogic(MainWin())

' 一、主窗口
' 主窗口总函数
Function MainWin() 
    dim id, mainWinTitle, mainWinTips
    Call Init_MainWin(mainWinTitle, mainWinTips)
    ' 创建交互输入框
    id = inputbox(mainWinTips, mainWinTitle)
    Call Robust_MainWin(id)
    MainWin = id
End Function

' （一）初始化主窗口提示内容
Sub Init_MainWin(mainWinTitle, mainWinTips) 
    dim enterpriseName  ' variateID = 111
    enterpriseName = gttwMapping.getVariateValue("111")
    dim userName
    userName = gttwMapping.getVariateValue("112")
    dim userAdj
    userAdj = praiseWords() + "的"
    dim inputIDTips
    inputIDTips = gttwMapping.getVariateValue("114")
    
    ' 1. 主窗口标题
    mainWinTitle = enterpriseName & "-" & userName
    ' 2. 提示用语
    mainWinTips = vbCrLf & userAdj & userName & vbCrLf _
                    + vbCrLf + inputIDTips
End Sub

' （二）主窗口健壮性处理
Sub Robust_MainWin(id)
    dim tipsWinTitle, tipsWinTips_ClickOKWhenBlank, tipsWinTips_ClickOKWhenNotPureNumber
    Call Init_Robust_MainWin(tipsWinTitle, tipsWinTips_ClickOKWhenBlank, tipsWinTips_ClickOKWhenNotPureNumber)
    
    ' 1. 如果inputbox返回值为Empty，即用户点击的是“取消”；
    If IsEmpty(id) Then  
        WScript.Quit 
    End If

    ' 2. 输入框内容为空时直接点击“确定”；
    If Len(id) = 0 Then  
        ' msgbox tipsWinTips_ClickOKWhenBlank, vbokcancel + vbInformation, tipsWinTitle
        Call promptWin(tipsWinTips_ClickOKWhenBlank, tipsWinTitle)
        WScript.Quit
    End If

    ' 3. id有字符但为非纯数字时
    If Not isnumeric(id) Then
        ' msgbox tipsWinTips_ClickOKWhenNotPureNumber, vbokcancel + vbInformation, tipsWinTitle
        Call promptWin(tipsWinTips_ClickOKWhenNotPureNumber, tipsWinTitle)
        WScript.Quit
    end if
End Sub

' （三）初始化主窗口健壮性处理提示窗口内容
Sub Init_Robust_MainWin(tipsWinTitle, tipsWinTips_ClickOKWhenBlank, tipsWinTips_ClickOKWhenNotPureNumber)
    ' 1. 初始化主窗口健壮性处理提示窗口标题
    tipsWinTitle = gttwMapping.getVariateValue("211")

    ' 2. 初始化主窗口健壮性处理提示用语
    ' （1）提示位置：一、（三）2.
    tipsWinTips_ClickOKWhenBlank = gttwMapping.getVariateValue("212")
    ' （2）提示位置：一、（三）3.
    tipsWinTips_ClickOKWhenNotPureNumber = gttwMapping.getVariateValue("213")
End Sub



' 二、主逻辑
' 主逻辑总函数
'（id为纯数字时）
' 
' 思路：
' 例如目标文件夹为：str = “E:\工作\2、222\1、开发冷战零撒扥\3、阿森简单 - 副本”
' 
' 解决：
' 直接从str中抽离“213”，然后与id直接比较，一样则直接打开此文件夹



' （一）定义相关变量和初始化并结束整个逻辑链

sub MainLogic(id)

    Dim objFSO, objWS, currentDir, separatorStr
    Set objFSO = CreateObject("Scripting.FileSystemObject") 
    Set objWS = WScript.CreateObject("wscript.shell")
    currentDir = objWS.CurrentDirectory
    separatorStr = gttwMapping.getVariateValue("121")
    Call SearchFolder(currentDir, objFSO, objWS, id, separatorStr)
    
    dim tipsWinTitle
    tipsWinTitle = gttwMapping.getVariateValue("211")
    dim tipsWinTips_IDNotReal
    tipsWinTips_IDNotReal = gttwMapping.getVariateValue("221")
    ' msgbox tipsWinTips_IDNotReal, vbokcancel + vbInformation, tipsWinTitle
    Call promptWin(tipsWinTips_IDNotReal, tipsWinTitle)
end sub




' （二）核心算法函数封装
Sub SearchFolder(folderPath, objFSO, objWS, id, separatorStr)   
    dim objFolder
	Set objFolder=objFSO.GetFolder(folderPath)
	Set SubFolders=objFolder.SubFolders
	If SubFolders.Count = 0 then
		'msgbox "exit search:" & folderPath
		exit Sub
	End If
    
    dim strIDTemp, ss, n, str, index, strTemp
	For Each subFolder In SubFolders
        strIDTemp = subFolder.path     
        ss = Split(strIDTemp, separatorStr, -1)
        n = UBound(ss) - 1
        str = ""
        For i = 0 to n
            strTemp = ss(i)
            index = Len(strTemp)
            str = str & Mid(strTemp, index, 1)
        next
        if StrComp(str, id) = 0 then
            ' msgbox strIDTemp
            Call openDir(strIDTemp, objWS)
            WScript.Quit
        end if
		Call SearchFolder(subFolder.path, objFSO, objWS, id, separatorStr)
	Next
End Sub

' 提示窗口
Sub promptWin(tips, title)
    msgbox tips, vbokcancel + vbInformation, title
End Sub

' 打开文件夹，这里主要是解决了路径带空格报错的问题
Sub openDir(dir, objWS)
    Const vbQuote = """"
    dir = vbQuote & dir & vbQuote
    objWS.run dir
End Sub



' GTTW制作的Mapping核心映射类
' 以程序设计的标准化、规范化、流程化为中心思想
' 最重要的是合适的抽象化
' 
' 此映射类给程序提供模板化设计思想
' 
' 此映射类主要功能：
' 映射所有与现实世界有关的变量
' 让程序设计依赖抽象，而不去依赖具体现实，符合依赖倒置原则
' 并提供可视化设置的数据接口
' 
' 感觉完全可以存到数据库呀！
' 

Class GTTW_Mapping

    ' Key Value Dictionary Variate
    
    ' IDValueDictVar
    ' IVDV  —>  ivdv
    ' （variateIDArr --> variateValueArr）
    ' “ID-值”键值对字典映射变量
    Private m_ivdv

    ' IDDescribeDictVar
    ' IDDV  —>  iddv
    ' （variateIDArr --> variateValueArr）
    ' “ID-描述”键值对字典映射变量
    Private m_iddv 
    
    Private m_variateIDArr  ' 需要主体程序设计的形而上变量的id数组
    Private m_variateValueArr  ' 需要从现实世界获取的变量的值数组
    Private m_variateDescribeArr  ' 需要主体程序设计的形而上变量的描述数组
    Private m_classifiedNumberArr  ' 需要主体程序传入的以上变量数组的分类分组数目数组
 
    ' Initialize事件相当于构造函数
    Private Sub Class_Initialize  ' 当这个类被创建时执行
        ' MsgBox "类开始"
        Set m_ivdv = WSH.CreateObject("Scripting.Dictionary")
        Set m_iddv = WSH.CreateObject("Scripting.Dictionary")
    End Sub
    
    Public Default Function Constructor(variateIDArr, variateDescribeArr, classifiedNumberArr)
        m_variateIDArr = variateIDArr
        m_variateDescribeArr = variateDescribeArr
        m_classifiedNumberArr = classifiedNumberArr
        ' Set Constructor = Me
    End Function
    
    ' 只读只写方法
    Public Property Get ivdv
        ivdv = m_ivdv
    End Property
    
    ' 注意————私有的
    Private Property Let ivdv(new_ivdv)
        m_ivdv = new_ivdv
    End Property 
    
    Public Property Get iddv
        iddv = m_iddv
    End Property
    
    ' 注意————私有的
    Private Property Let iddv(new_iddv)
        m_iddv = new_iddv
    End Property 
     
    Public Property Get variateIDArr
        variateIDArr = m_variateIDArr
    End Property 
    
    Public Property Let variateIDArr(new_variateIDArr)
        m_variateIDArr = new_variateIDArr
    End Property   
    
    Public Property Get variateValueArr
        variateValueArr = m_variateValueArr
    End Property  
    
    ' 注意————之后要改为私有的
    Public Property Let variateValueArr(new_variateValueArr)
        m_variateValueArr = new_variateValueArr
    End Property      
    
    Public Property Get variateDescribeArr
        variateDescribeArr = m_variateDescribeArr
    End Property  
    
    Public Property Let variateDescribeArr(new_variateDescribeArr)
        m_variateDescribeArr = new_variateDescribeArr
    End Property 
    
    Public Property Get classifiedNumberArr
        classifiedNumberArr = m_classifiedNumberArr
    End Property  
    
    Public Property Let classifiedNumberArr(new_classifiedNumberArr)
        m_classifiedNumberArr = new_classifiedNumberArr
    End Property  
    
    ' 建立两个映射
    Public Sub createMapping()
        dim i, n
        n = ubound(m_variateIDArr)
        For i = 0 to n
            m_ivdv.Add m_variateIDArr(i), m_variateValueArr(i)
        Next 
        For i = 0 to n
            m_iddv.Add m_variateIDArr(i), m_variateDescribeArr(i)
        Next 
    End Sub  
    
    ' 以变量id得到相应变量在现实世界的值
    Public Function getVariateValue(variateID)
        getVariateValue = m_ivdv.Item(variateID)
    End Function
    
    ' 以变量id得到相应变量在现实世界的描述
    Public Function getVariateDescribe(variateID)
        getVariateDescribe = m_iddv.Item(variateID)
    End Function
End Class

Function praiseWords()
    dim str
    str = "独立 大方 爱美 善于交际 另类 有耐力 温柔 体贴 有见识 有仪态 撒娇 任性 美丽 善良 大方 优雅 文静 " & _
        "活泼 率直 可爱 天真 端庄 温柔 贤惠 多才 俊俏 国色天香 倾国倾城 美艳绝世 清丽绝俗 天生丽质 开朗 贤淑 纯洁 " & _
        "回眸一笑百媚生 沉鱼落雁 闭月羞花 貌赛西施 风华绝代 仪态万端 婉风流转 美撼凡尘 聘婷秀雅 娥娜翩跹 俏丽多姿 " & _
        "风姿卓越 顾盼流转 清丝纠缠 举步轻摇 明艳不可方物 闭月羞花 沉鱼落雁 倾国倾城 温婉娴淑 千娇百媚 仪态万千 " & _ 
        "美若天仙 美愈天人 不施粉黛天然美 清秀高雅 姿容绝代 玉指如葱 肤如凝脂 眉如新月 秋波流转 樱桃小口 美人微笑转星眸 " & _
        "国色天香 花容月貌 明目皓齿 淡扫峨眉 清艳脱俗 香肌玉肤 艳冠群芳 剪水双瞳 美艳绝伦 神仙玉骨 楚楚动人 脱俗 " & _
        "如花似玉 倾国倾城 静若处子 动若脱兔 螓首蛾眉 淡妆浓抹 双瞳剪水 貌美如花 姿容绝代 玉指如葱 肤如凝脂 清秀高雅 " & _
        "绝代佳人 仙姿佚貌 冰肌玉骨 眉目如画 环肥燕瘦 眉清目秀 千娇百媚 梨花带雨 清艳脱俗 妖娆动人 艳光四射 淡扫峨眉 " & _
        "仪态万端 婉风流转 美撼凡尘 聘婷秀雅 娇小玲珑 小家碧玉 粉装玉琢 夭桃秾李 美如冠玉 红飞翠舞 齿白唇红 绰约多姿 " & _
        "美若天仙 美愈天人 貌赛西施 美艳绝世 娥娜翩跹 俏丽多姿 艳冠群芳 剪水双瞳 秋波流转 樱桃小口 空谷幽兰 眉如新月 " & _
        "清丽脱俗 花容月貌 明眸皓齿 天生丽质 亭亭玉立 如花似玉 花枝招展 出水芙蓉 宛转蛾眉 靡颜腻理 粉妆玉琢 月里嫦娥 " & _
        "国色天姿 玉貌花容 秀外惠中 仙姿玉貌 美艳绝伦 神仙玉骨 楚楚动人 顾盼流转 唇红齿白 风情万众 顾盼生姿 明眸善睐 " & _
        "齿如编贝 目若朗星 明眸皓齿 恍若天人 沉鱼落雁 倾国倾城 国色天香 闭月羞花"

    dim strArr
    strArr = split(str, " ")

    n = UBound(strArr)
    ran = GetRandomInt(1, n)
    praiseWords = strArr(ran)
End Function

Function GetRandomInt(m,n)
    dim ran
    ran = Second(Now) * 3
    While ran > n Or ran < m
        If ran > n Then
            ran = ran - day(Now)
        End If
        If ran < m Then
            ran = ran + Second(Now)
        End If
    Wend
    GetRandomInt = ran
End Function


v5.0 增加了自动获取并显示文件夹名称结构层次的显示功能
（但问题是，1，显示窗口是独立的，多了一步，麻烦了。2，如果文件夹太多，显示不全，此情况待解决。

应该上工程了。

）
' 
' 候帅洲
'
' 手机和微信：175 3102 3301
'
' 此小项目CSDN详解博客地址：https://blog.csdn.net/weixin_44591035/article/details/113667614
'
'
' 1、需求分析
' 一个盘里的文件名字开头全有10以内数字编号开头，
' 要求弹出窗口输入一串数字编号，便可以打开指定文件夹。
' 
' 
' 2、举例
' 弹出交互窗口输入“122”，点击确认，
' 即可打开文件夹地址为：
' “E:\工作\1、人事\2、培训\2、实习期”。
' 其中，后面的顿号和汉字是任意的，
' 只关注文件名前面的数字即可。
' 
' 
' 3、目前进度
' 第五个版本，v5
' 增加窗口显示目录结构和对应编号
'

' ——————————————————————————————————————————————————————————————————
' 
'···························！！！注意！！！！！！
' 
' 目前算法编码严格要求两个准则：
' 1、每个文件夹数字编号必须是文件名称的第一个字符并只能用一位阿拉伯数字表示
' 2、每个文件夹数字编号与文件夹名的分割符号，
'   紧跟在数字后面并只有一个，且文件夹名称只能含一个
'   （目前分隔符为顿号“、”，可改，但不推荐）
' 
' ——————————————————————————————————————————————————————————————————


dim variateValueArr
variateValueArr = Array( _
            _
            "您想打开那个文件夹呢？" & vbCrLf & "请稍微记一下要打开的文件夹后面对应的编号吧！" & vbCrLf , _
            _
            "博瑞智（邯郸）家庭教育服务中心", _
            "文文姐", _
            vbCrLf & "现在，" & vbCrLf & vbCrLf & "请输入要打开的文件夹编号吧！", _
            _
            "候帅洲说：", _
            "没有输入任何编号哦！！！", _
            "输入的不是纯数字哦！！！", _
            "输入的编号没有对应的文件夹哦！！！", _     
            _
            "、", _
            "6", _
            "4" _
) 

dim variateIDArr
variateIDArr = Array( _
            _
            "110", _
            _
            "111", _
            "112", _
            "114", _
            _
            "211", _
            "212", _
            "213", _
            "221", _      
            _
            "121", _ 
            "122", _ 
            "123" _
)

' 变量id（变量名称）：该变量描述。
dim variateDescribeArr
variateDescribeArr = Array( _
            "110（tipsTitle）：展示文件树的首窗口提示用语。", _
            _
            "111（enterpriseName）：企业名称（个人当然也可以用了，一个人对待自己电脑里的资源就要像对待自己的公司一样）。", _
            "112（userName）：用户名称。",             "113（userAdj）：用户的描述，狠劲夸即可。", _
            "114（inpuIDTips）：输入ID时的提示用语，要礼貌，也狠劲夸即可。", _
            _
            "211（tipsWinTitle）：提示窗口的边框上标题。", _
            "212（tipsWinTips_ClickOKWhenBlank）：文本输入框没有内容就点击了确认的提示用语。", _
            "213（tipsWinTips_ClickOKWhenNotPureNumber）：文本框输入的内容不是纯数字时的提示用语。", _
            "221（tipsWinTips_IDNotReal）：文本框输入的纯数字没有对应真实存在的文件夹ID编号。", _  
            _
            "232（separatorStr)：文件夹数字编号与文件夹名的分割符号。", _
            "122（levelIndentSpaceNumber）：文件夹树型结构展示窗口中文件夹名称前面的缩进空格数量", _
            "123（numberIndentSpaceNumber)：文件夹树型结构展示窗口中文件夹名称和后面自动生成编号直接的空间隙的空格数量（目前的设计为纯空格）。" _
)

' dim classifiedNumberArr
' classifiedNumberArr = Array(4, 4, 1)

dim gttwMapping
Set gttwMapping = New GTTW_Mapping
gttwMapping.variateIDArr = variateIDArr
gttwMapping.variateDescribeArr = variateDescribeArr
gttwMapping.variateValueArr = variateValueArr
gttwMapping.createMapping()

Dim objFSO, objWS
Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objWS = WScript.CreateObject("wscript.shell")

dim currentDir
currentDir = objWS.CurrentDirectory

Dim filesTree



' 程序入口
' 黑格尔写法，一切都在宇宙的逻辑之中，唯心主义
Call MainLogic(MainWin())

' 一、主窗口
' 主窗口总函数
Function MainWin() 
	dim separatorStr
	separatorStr = gttwMapping.getVariateValue("121")
    Call showFolderStructure(currentDir, separatorStr)

	dim tipsWinTitle
    tipsWinTitle = gttwMapping.getVariateValue("211")
    Call showFolderStructureWin(filesTree, tipsWinTitle)  

    dim id, mainWinTitle, mainWinTips
    Call Init_MainWin(mainWinTitle, mainWinTips)
    ' 创建交互输入框
    id = inputbox(mainWinTips, mainWinTitle)
    Call Robust_MainWin(id)
    MainWin = id
End Function

' （一）初始化主窗口提示内容
Sub Init_MainWin(mainWinTitle, mainWinTips) 
    ' 1. 主窗口标题
    mainWinTitle = gttwMapping.getVariateValue("211")
    ' 2. 提示用语
    mainWinTips = gttwMapping.getVariateValue("114")
End Sub

' （二）主窗口健壮性处理
Sub Robust_MainWin(id)
    dim tipsWinTitle, tipsWinTips_ClickOKWhenBlank, tipsWinTips_ClickOKWhenNotPureNumber
    Call Init_Robust_MainWin(tipsWinTitle, tipsWinTips_ClickOKWhenBlank, tipsWinTips_ClickOKWhenNotPureNumber)
    
    ' 1. 如果inputbox返回值为Empty，即用户点击的是“取消”；
    If IsEmpty(id) Then  
        WScript.Quit 
    End If

    ' 2. 输入框内容为空时直接点击“确定”；
    If Len(id) = 0 Then  
        ' msgbox tipsWinTips_ClickOKWhenBlank, vbokcancel + vbInformation, tipsWinTitle
        Call promptWin(tipsWinTips_ClickOKWhenBlank, tipsWinTitle)
        WScript.Quit
    End If

    ' 3. id有字符但为非纯数字时
    If Not isnumeric(id) Then
        ' msgbox tipsWinTips_ClickOKWhenNotPureNumber, vbokcancel + vbInformation, tipsWinTitle
        Call promptWin(tipsWinTips_ClickOKWhenNotPureNumber, tipsWinTitle)
        WScript.Quit
    end if
End Sub

' （三）初始化主窗口健壮性处理提示窗口内容
Sub Init_Robust_MainWin(tipsWinTitle, tipsWinTips_ClickOKWhenBlank, tipsWinTips_ClickOKWhenNotPureNumber)
    ' 1. 初始化主窗口健壮性处理提示窗口标题
    tipsWinTitle = gttwMapping.getVariateValue("211")

    ' 2. 初始化主窗口健壮性处理提示用语
    ' （1）提示位置：一、（三）2.
    tipsWinTips_ClickOKWhenBlank = gttwMapping.getVariateValue("212")
    ' （2）提示位置：一、（三）3.
    tipsWinTips_ClickOKWhenNotPureNumber = gttwMapping.getVariateValue("213")
End Sub



' 二、主逻辑
' 主逻辑总函数
'（id为纯数字时）
' 
' 思路：
' 例如目标文件夹为：str = “E:\工作\2、222\1、开发冷战零撒扥\3、阿森简单 - 副本”
' 
' 解决：
' 直接从str中抽离“213”，然后与id直接比较，一样则直接打开此文件夹



' （一）定义相关变量和初始化并结束整个逻辑链

sub MainLogic(id)

    ' Dim objFSO, objWS
    ' dim currentDir
    ' Set objFSO = CreateObject("Scripting.FileSystemObject") 
    ' Set objWS = WScript.CreateObject("wscript.shell")
    ' currentDir = objWS.CurrentDirectory

    dim separatorStr
    separatorStr = gttwMapping.getVariateValue("121")
    Call SearchFolder(currentDir, id, separatorStr)
    
    dim tipsWinTitle
    tipsWinTitle = gttwMapping.getVariateValue("211")
    dim tipsWinTips_IDNotReal
    tipsWinTips_IDNotReal = gttwMapping.getVariateValue("221")
    ' msgbox tipsWinTips_IDNotReal, vbokcancel + vbInformation, tipsWinTitle
    Call promptWin(tipsWinTips_IDNotReal, tipsWinTitle)
end sub




' （二）核心算法函数封装
' 1. id匹配文件夹
Sub SearchFolder(folderPath, id, separatorStr)   
    dim objFolder
	Set objFolder=objFSO.GetFolder(folderPath)
	Set SubFolders=objFolder.SubFolders
	If SubFolders.Count = 0 then
		'msgbox "exit search:" & folderPath
		exit Sub
	End If
    
    dim strIDTemp, str
	For Each subFolder In SubFolders
        strIDTemp = subFolder.path     
        str = splitJointNumber_Func(strIDTemp, separatorStr)
        if StrComp(str, id) = 0 then
            ' msgbox strIDTemp
            Call openDir(strIDTemp, objWS)
            WScript.Quit
        end if
		Call SearchFolder(subFolder.path, id, separatorStr)
	Next
End Sub


' 2. 文件夹清晰结构展示
Sub showFolderStructure(folderPath, separatorStr)   
    Set objFolder=objFSO.GetFolder(folderPath)
    Set SubFolders=objFolder.SubFolders
    If SubFolders.Count = 0 then
        'msgbox "exit search:" & folderPath
        exit Sub
    End If
    
    For Each subFolder In SubFolders
        s = subFolder.path
        Call showFolderNameByLevelSpace(s, separatorStr)
        Call showFolderStructure(s, separatorStr)
    Next
 
End Sub

' 文件夹清晰结构展示算法核心
Sub showFolderNameByLevelSpace(fullPath, separatorStr)
    dim index, fullFolderName, folderName
    dim ss, n, splitJointNumber
    dim initialChar, secondChar
    dim levelIndentStr,levelIndentSpaceNumber
    dim numberIndentStr, numberIndentSpaceNumber
    levelIndentSpaceNumber = gttwMapping.getVariateValue("122")
    numberIndentSpaceNumber = gttwMapping.getVariateValue("123")

    index = InstrRev(fullPath, "\") + 1
    fullFolderName = Mid(fullPath, index)
    folderName = Mid(fullFolderName, 3)
    ss = Split(fullPath, separatorStr, -1)
    n = UBound(ss)

    initialChar = Asc(fullFolderName)
    secondChar = Mid(fullFolderName, 2, 1)
    levelIndentStr = Space(levelIndentSpaceNumber * n)
    numberIndentStr = Space(numberIndentSpaceNumber)
    splitJointNumber = splitJointNumber_Func(fullPath, separatorStr) 


    If initialChar >= Asc("0") _
        And initialChar <= Asc("9") _
        And StrComp(secondChar, separatorStr) = 0 Then

        If Len(splitJointNumber) = 1 Then
            filesTree = filesTree & vbCrLf & vbCrLf
        End If

        filesTree = filesTree & levelIndentStr _
                     & folderName _
                     & numberIndentStr _
                     & splitJointNumber _
                     & vbCrLf
                      ' & "→"
    End If


End Sub

' 从绝对路径抽离文件夹全编号
Function splitJointNumber_Func(fullPath, separatorStr)
    dim ss, n, str, index, strTemp

    ss = Split(fullPath, separatorStr, -1)
    n = UBound(ss) - 1
    str = ""
    For i = 0 to n
        strTemp = ss(i)
        index = Len(strTemp)
        str = str & Mid(strTemp, index, 1)
    next
    splitJointNumber_Func = str
End Function


' 文件夹树型结构展示窗口
Sub showFolderStructureWin(tipsContent, title)
    dim userName
    userName = gttwMapping.getVariateValue("112")
    dim userAdj
    userAdj = praiseWords() + "的"
    dim tipsTitle
    tipsTitle = userAdj & userName & "! " & gttwMapping.getVariateValue("110")
    tips = tipsTitle & tipsContent
	msgbox tips, vbQuestion, title
End Sub

' 提示窗口
Sub promptWin(tips, title)
    dim userName
    userName = gttwMapping.getVariateValue("112")
    tips = userAdj & userName & tips
    msgbox tips, vbokcancel + vbInformation, title
End Sub

' 打开文件夹，这里主要是解决了路径带空格报错的问题
Sub openDir(dir, objWS)
    Const vbQuote = """"
    dir = vbQuote & dir & vbQuote
    objWS.run dir
End Sub



' GTTW制作的Mapping核心映射类
' 以程序设计的标准化、规范化、流程化为中心思想
' 最重要的是合适的抽象化
' 
' 此映射类给程序提供模板化设计思想
' 
' 此映射类主要功能：
' 映射所有与现实世界有关的变量
' 让程序设计依赖抽象，而不去依赖具体现实，符合依赖倒置原则
' 并提供可视化设置的数据接口
' 
' 感觉完全可以存到数据库呀！
' 

Class GTTW_Mapping

    ' Key Value Dictionary Variate
    
    ' IDValueDictVar
    ' IVDV  —>  ivdv
    ' （variateIDArr --> variateValueArr）
    ' “ID-值”键值对字典映射变量
    Private m_ivdv

    ' IDDescribeDictVar
    ' IDDV  —>  iddv
    ' （variateIDArr --> variateValueArr）
    ' “ID-描述”键值对字典映射变量
    Private m_iddv 
    
    Private m_variateIDArr  ' 需要主体程序设计的形而上变量的id数组
    Private m_variateValueArr  ' 需要从现实世界获取的变量的值数组
    Private m_variateDescribeArr  ' 需要主体程序设计的形而上变量的描述数组
    Private m_classifiedNumberArr  ' 需要主体程序传入的以上变量数组的分类分组数目数组
 
    ' Initialize事件相当于构造函数
    Private Sub Class_Initialize  ' 当这个类被创建时执行
        ' MsgBox "类开始"
        Set m_ivdv = WSH.CreateObject("Scripting.Dictionary")
        Set m_iddv = WSH.CreateObject("Scripting.Dictionary")
    End Sub
    
    Public Default Function Constructor(variateIDArr, variateDescribeArr, classifiedNumberArr)
        m_variateIDArr = variateIDArr
        m_variateDescribeArr = variateDescribeArr
        m_classifiedNumberArr = classifiedNumberArr
        ' Set Constructor = Me
    End Function
    
    ' 只读只写方法
    Public Property Get ivdv
        ivdv = m_ivdv
    End Property
    
    ' 注意————私有的
    Private Property Let ivdv(new_ivdv)
        m_ivdv = new_ivdv
    End Property 
    
    Public Property Get iddv
        iddv = m_iddv
    End Property
    
    ' 注意————私有的
    Private Property Let iddv(new_iddv)
        m_iddv = new_iddv
    End Property 
     
    Public Property Get variateIDArr
        variateIDArr = m_variateIDArr
    End Property 
    
    Public Property Let variateIDArr(new_variateIDArr)
        m_variateIDArr = new_variateIDArr
    End Property   
    
    Public Property Get variateValueArr
        variateValueArr = m_variateValueArr
    End Property  
    
    ' 注意————之后要改为私有的
    Public Property Let variateValueArr(new_variateValueArr)
        m_variateValueArr = new_variateValueArr
    End Property      
    
    Public Property Get variateDescribeArr
        variateDescribeArr = m_variateDescribeArr
    End Property  
    
    Public Property Let variateDescribeArr(new_variateDescribeArr)
        m_variateDescribeArr = new_variateDescribeArr
    End Property 
    
    Public Property Get classifiedNumberArr
        classifiedNumberArr = m_classifiedNumberArr
    End Property  
    
    Public Property Let classifiedNumberArr(new_classifiedNumberArr)
        m_classifiedNumberArr = new_classifiedNumberArr
    End Property  
    
    ' 建立两个映射
    Public Sub createMapping()
        dim i, n
        n = ubound(m_variateIDArr)
        For i = 0 to n
            m_ivdv.Add m_variateIDArr(i), m_variateValueArr(i)
        Next 
        For i = 0 to n
            m_iddv.Add m_variateIDArr(i), m_variateDescribeArr(i)
        Next 
    End Sub  
    
    ' 以变量id得到相应变量在现实世界的值
    Public Function getVariateValue(variateID)
        getVariateValue = m_ivdv.Item(variateID)
    End Function
    
    ' 以变量id得到相应变量在现实世界的描述
    Public Function getVariateDescribe(variateID)
        getVariateDescribe = m_iddv.Item(variateID)
    End Function
End Class


Function praiseWords()
    dim str
    str = "独立 大方 爱美 善于交际 另类 有耐力 温柔 体贴 有见识 有仪态 撒娇 任性 美丽 善良 大方 优雅 文静 " & _
        "活泼 率直 可爱 天真 端庄 温柔 贤惠 多才 俊俏 国色天香 倾国倾城 美艳绝世 清丽绝俗 天生丽质 开朗 贤淑 纯洁 " & _
        "回眸一笑百媚生 沉鱼落雁 闭月羞花 貌赛西施 风华绝代 仪态万端 婉风流转 美撼凡尘 聘婷秀雅 娥娜翩跹 俏丽多姿 " & _
        "风姿卓越 顾盼流转 清丝纠缠 举步轻摇 明艳不可方物 闭月羞花 沉鱼落雁 倾国倾城 温婉娴淑 千娇百媚 仪态万千 " & _ 
        "美若天仙 美愈天人 不施粉黛天然美 清秀高雅 姿容绝代 玉指如葱 肤如凝脂 眉如新月 秋波流转 樱桃小口 美人微笑转星眸 " & _
        "国色天香 花容月貌 明目皓齿 淡扫峨眉 清艳脱俗 香肌玉肤 艳冠群芳 剪水双瞳 美艳绝伦 神仙玉骨 楚楚动人 脱俗 " & _
        "如花似玉 倾国倾城 静若处子 动若脱兔 螓首蛾眉 淡妆浓抹 双瞳剪水 貌美如花 姿容绝代 玉指如葱 肤如凝脂 清秀高雅 " & _
        "绝代佳人 仙姿佚貌 冰肌玉骨 眉目如画 环肥燕瘦 眉清目秀 千娇百媚 梨花带雨 清艳脱俗 妖娆动人 艳光四射 淡扫峨眉 " & _
        "仪态万端 婉风流转 美撼凡尘 聘婷秀雅 娇小玲珑 小家碧玉 粉装玉琢 夭桃秾李 美如冠玉 红飞翠舞 齿白唇红 绰约多姿 " & _
        "美若天仙 美愈天人 貌赛西施 美艳绝世 娥娜翩跹 俏丽多姿 艳冠群芳 剪水双瞳 秋波流转 樱桃小口 空谷幽兰 眉如新月 " & _
        "清丽脱俗 花容月貌 明眸皓齿 天生丽质 亭亭玉立 如花似玉 花枝招展 出水芙蓉 宛转蛾眉 靡颜腻理 粉妆玉琢 月里嫦娥 " & _
        "国色天姿 玉貌花容 秀外惠中 仙姿玉貌 美艳绝伦 神仙玉骨 楚楚动人 顾盼流转 唇红齿白 风情万众 顾盼生姿 明眸善睐 " & _
        "齿如编贝 目若朗星 明眸皓齿 恍若天人 沉鱼落雁 倾国倾城 国色天香 闭月羞花"

    dim strArr
    strArr = split(str, " ")

    n = UBound(strArr)
    ran = GetRandomInt(1, n)
    praiseWords = strArr(ran)
End Function

Function GetRandomInt(m,n)
    dim ran
    ran = Second(Now) * 3
    While ran > n Or ran < m
        If ran > n Then
            ran = ran - day(Now)
        End If
        If ran < m Then
            ran = ran + Second(Now)
        End If
    Wend
    GetRandomInt = ran
End Function

众所周知，vbs是没法通过直接用下面的代码跳出两个弹窗的：
msgbox "HelloWorld"
msgbox "HelloWorld"

但是，有时候我们会在一些vbs做的病毒上看到，病毒同时打开了多个弹窗，这是怎么做到的呢？有一些人肯定会非常疑惑。
这时候就有人想说了，我这样子写两个vbs不就可以解决了吗：
'新建一个vbs文件，命名为1.vbs
'将下面的代码写进1.vbs
msgbox "HelloWorld"
'保存

'再新建一个vbs文件，命名为2.vbs
'将下面的代码写进2.vbs
do
createobject("wscript.shell").run "1.vbs"
loop
'保存，并运行2.vbs

这样子就可以做到无限弹窗了，就是要准备一下taskkill/f/t/im wscript.exe
但是这个效果，是你用两个vbs写出来的，只用一个vbs写出来不香么。所以，接下来我就给大家看看，只用一个vbs文件是如何做到这种效果的。
do
wscript.createobject("wscript.shell").run "mshta vbscript:msgbox(""拒绝访问C:\"")(window.close)",vhide
loop

怎么样，是不是很简单呢？

这里用到mshta.exe，直接批量跳出弹窗，是不是学到了呢？

什么！你说这个不好用？还很麻烦？没关系，我还给你准备了个好康的——
dim ws
set ws = wscript.createobject("wscript.shell")
a = inputbox("请输入弹窗数量","提示",30)
for i = 1 to a
ws.run "mshta vbscript:msgbox(""拒绝访问C:\"",4096+48,""Windows警告"")(window.close)",vhide
next

嘿嘿，这样子就不用准备任务管理器或者taskkill/f/t/im wscript.exe啦！界面是模仿病毒的，vbs病毒有一些常常会模仿系统的提示窗口，各位小伙伴不要轻易上当咯。
我分享这篇文章，只是为了展示某些病毒式vbs文件是如何工作的，请勿恶搞你的朋友们噢！
本文只是我无聊时随便写的，可能写的不太好。看不太懂的可以在评论区询问我！