VBScript/VBA使用UsedRange确定Excel的有效可读数据区域

Excel的有效可读数据区域是指拥有数据的最大范围,比如只有100行50列拥有数据区域,那么其Range就是100*50的范围。正常情况下,我们要如何编程获得这个区域呢,其实我们可以借助于UsedRange这个方法,下面举个简单的例子,比如用VBScript或者VBA将有效数据区域的行高度自动(自动调整行高),那么可以参考下面的VBScript代码:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Option Explicit
 
Const MSEXCEL_FILENAME = "Excel文件路径"
Sub VBMain()
  Dim xlApp, WorkBooks, Sheet
  Set xlApp = WSH.CreateObject("Excel.Application")
  xlApp.Visible = False
  Set WorkBooks = xlApp.Workbooks.Open(MSEXCEL_FILENAME)
 
  Set Sheet = WorkBooks.Worksheets(1)  '打开第一个工作表
  ' 也可以打开上次保存时打开的活动工作表
  ' Set Sheet = WorkBooks.ActiveSheet  打开活动的工作表
  Sheet.UsedRange.EntireRow.AutoFit ' 自动调整行高
  Set Sheet = Nothing
 
  WorkBooks.Close
  Set WorkBooks = Nothing
  xlApp.Quit
  Set xlApp = Nothing
End Sub
 
Call VBMain()
WSH.Quit()

那么如何获取有效区域的行数和列数呢,参照上面的代码其实可以使用Sheet.UsedRange.Rows.Count或者Sheet.UsedRange.Columns.Count分别取得。

使用BuiltInDocumentProperties设置或查询Word内置属性

Word的内置属性(WdBuiltInProperty)往往给我们提供了很多有用的信息,我们可以通过BuiltInDocumentProperties的方式进行访问这些属性,参考下面的VBScript代码:

1
2
3
4
5
6
Dim wdApp
Set wdApp = WSH.CreateObject("Word.Application")
wdApp.ActiveDocument.BuiltInDocumentProperties(Index)
' Set doc = wdApp.Documents.Open(...)
' doc.BuiltInDocumentProperties(Index) 这样也可以
Set wdApp = Nothing

注意这里的Index索引属性,其取值不同就代表操作不同的内置属性,其相关取值用Visual Basic描述如下:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Public Enum wdAttributes
  wdPropertyTitle = &H00000001 ' 标题
  wdPropertySubject = &H0000002 ' 主题
  wdPropertyAuthor = &H0000003 ' 作者
  wdPropertyKeywords = &H0000004 ' 关键词
  wdPropertyComments = &H0000005 ' 注释
  wdPropertyTemplate = &H0000006 ' 模板
  wdPropertyLastAuthor = &H0000007 ' 最后一次作者
  wdPropertyRevision = &H0000008 ' 校对修改
  wdPropertyAppName = &H0000009 ' 应用程序名
  wdPropertyTimeLastPrinted = &H000000A ' 最后一次打印时间
  wdPropertyTimeCreated = &H000000B ' 创建时间
  wdPropertyTimeLastSaved = &H000000C ' 最后一次保存时间
  wdPropertyVBATotalEdit = &H000000D ' VBA Edits的数目
  wdPropertyPages = &H000000E ' 总页数
  wdPropertyWords = &H000000F ' 总字数
  wdPropertyCharacters = &H0000010 ' 总字符数
  wdPropertySecurity = &H0000011 ' 安全设置
  wdPropertyCategory = &H0000012 ' 类别
  wdPropertyFormat = &H0000013 ' (尚未支持)
  wdPropertyManager = &H0000014 ' 管理器
  wdPropertyCompany = &H0000015 ' 公司
  wdPropertyBytes = &H0000016 ' 字节数
  wdPropertyLines = &H0000017 ' 行数
  wdPropertyParas = &H0000018 ' 段落数
  wdPropertySlides = &H0000019 ' (尚未支持)
  wdPropertyNotes = &H000001A ' 便签数
  wdPropertyHiddenSlides = &H000001B ' (尚未支持)
  wdPropertyMMClips = &H000001C ' (尚未支持)
  wdPropertyHyperlinkBase = &H000001D ' (尚未支持)
  wdPropertyCharsWSpaces = &H000001E ' 带空白字符的字符统计
end Enum

参考.NET版实现《WdBuiltInProperty Enumeration》

VBScript/VBA设置Word文档的页眉或页脚

由于工作需要我们常常需要批量设置Word文档的页眉或者页脚,除了递归遍历Word文件外,我们还需要借助Word.Application组件来实现页眉或页脚的增加或修改。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Option Explicit
 
Const MSWORD_FILENAME = "Word文件路径"
 
Const wdSeekCurrentPageFooter = 10
Const wdAlignParagraphCenter = 1
Const wdAlignParagraphRight = 2
Const wdSeekMainDocument = 0
 
Dim wdApp
Set wdApp = WSH.CreateObject( "Word.Application")
wdApp.visible = False
 
Set doc = wdApp.Documents.Open(MSWORD_FILENAME)
doc.Activate ' 激活打开的文档
doc.PageSetup.FooterDistance = 30 ' 设置页脚到页面底边的距离
 
' 定位到页脚
wdApp.ActiveWindow.ActivePane.View.SeekView _
 = wdSeekCurrentPageFooter
' 下面是针对字体的设置
wdApp.Selection.Font.Name = "Times New Roman"
wdApp.Selection.Font.Size = 14 ' 字号
wdApp.Selection.Font.Bold = True ' 加粗
wdApp.Selection.Text = "页脚0001"  ' 页脚文本
' 页脚文本的位置wdAlignParagraphRight为居右
wdApp.Selection.ParagraphFormat.Alignment _
 = wdAlignParagraphRight
' 返回定位到主文档
wdApp.ActiveWindow.ActivePane.View.SeekView _
 = wdSeekMainDocument
 
doc.Save ' 保存刚才的修改
doc.Close ' 关闭文档
Set doc = Nothing
 
wdApp.visible = True
wdApp.Quit
Set wdApp = Nothing

这里要注意的是设置页脚到底边距离的时候需要用到页面设置的功能,即PageSetup.FooterDistance。

VBScript实现Word和Excel的打印

只要是安装了Microsoft Office的Word和Excel电脑,微软都为我们提供了Word和Excel的COM组件,方便我们以COM对象访问的形式操纵Word或Excel文件,今天介绍个小功能,那就是打印。

首先是Word的打印,基本上的流程就是创建Word.Application对象,然后调用Documents.Open的方式打开doc文件,然后执行PrintOut方法打印文件,然后Close关闭,最后退出并销毁Word.Application对象。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Option Explicit
 
Const MSWORD_FILENAME = "Word文件路径"
Sub VBMain()
  Dim wdApp, Doc
  Set wdApp = WSH.CreateObject("Word.Application")
  wdApp.Visible = False
  Set Doc = wdApp.Documents.Open(MSWORD_FILENAME)
  Doc.PrintOut
  Doc.Close
  Set Doc = Nothing
  wdApp.Visible = True
  wdApp.Quit
  Set wdApp = Nothing
End Sub
 
Call VBMain()
WSH.Quit()

最后介绍下Excel的打印,同样的道理,创建对象,打开要打印的工作簿,选择要打印的工作表,打印,然后关闭工作表,退出并销毁对象。同样的一些操作可以参考Excel的VBA手册《Microsoft Excel Visual Basic参考》

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Option Explicit
 
Const MSEXCEL_FILENAME = "Excel文件路径"
Sub VBMain()
  Dim xlApp, WorkBooks, Sheet
  Set xlApp = WSH.CreateObject("Excel.Application")
  xlApp.Visible = False
  Set WorkBooks = xlApp.Workbooks.Open(MSEXCEL_FILENAME)
 
  Set Sheet = WorkBooks.Worksheets(1)  '打开第一个工作表
  ' 也可以打开上次保存时打开的活动工作表
  ' Set Sheet = WorkBooks.ActiveSheet  打开活动的工作表
  Sheet.PrintOut
  Set Sheet = Nothing
 
  WorkBooks.Close
  Set WorkBooks = Nothing
  xlApp.Quit
  Set xlApp = Nothing
End Sub
 
Call VBMain()
WSH.Quit()

对于想批量打印的朋友可以参考我这篇文章《采用插件机制的批量文件扫描及进程处理工具》

使用Scripting.Dictionary字典对象

Scripting.Dictionary是个很有用的组件,其创建了类似于Key索引对应Value值的字典对象,并且在其内部提供了快速索引访问的机制,可以让我们通过Key直接索引到指定的Value,比遍历二维数组有效得多。

其在VBScript中是这样访问的。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Dim objDict
Set objDict = WSH.CreateObject("Scripting.Dictionary")
  ' .Add(key, value)    
  objDict.Add "a", "value1"
  objDict.Add "b", "value2"
  objDict.Add "c", "value3"
  '直接通过key=b索引到value2
  WSH.Echo objDict.Item("b")
  objDict.Remove "b" ' 删除索引b及其对应的值
 
  ' 以下是遍历字典
  Dim objKeys, objItems, i
  objKeys = objDict.Keys
  objItems = objDict.Items
  For i = 0 To objDict.Count -1
    WSH.Echo "Key=" & objKeys(i) &_
             " AND Value=" & objItems(i)
  Next
  ' 判断指定的key是否存在
  If objDict.Exists("b") Then
    WSH.Echo "Found it"
  Else
    WSH.Echo "Not Exists!"
  End If
  objDict.RemoveAll  ' 清空字典内所有的key及其对应value
Set objDict = Nothing

当然在JScript访问的方式一样,但是在遍历这里需要一点点变动。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
  var dict = WSH.CreateObject("Scripting.Dictionary");
  dict.Add("a", "value1");
  dict.Add("b", "value2");
  dict.Add("c", "value3");
  WSH.Echo(dict.Item("b"));
  dict.Remove("b");
 
  // 注意这里的遍历
  var keys = new VBArray(dict.Keys());
  var items = new VBArray(dict.Items());
 
  for (var i=0; i < dict.Count; i++) {
    WSH.Echo("Key=" + keys.getItem(i) +
             " AND Value=" + items.getItem(i));	
  }
 
  if (dict.Exists("b")) {
    WSH.Echo("Found it");
  } else {
    WSH.Echo("Not Exists!");
  }
 
  dict.RemoveAll();

由于Scripting.Dictionary的Keys和Items的集合返回的是VB安全数组,也就是说JScript访问需要多个转换的步骤,方法就是采用new VBArray()对象,相关信息可以参考MSDN的《VBArray Objects》,当获得VBArray对象后就可以通过getItem方法获取数组元素了,值得注意的是这个VBArray对象自己不创建数组,其只起到一个转换的作用,也可以将其看成是一个操作接口吧。当然其toArray()方法可以将其转换为真正的JScript数组,届时可以直接像操作JScript数组一样操作VBArray转换的对象了。

Excel中VBA简单的编程技巧

最近在单位经常要整理Excel表格,大量的数据有时候用公式函数处理也略显麻烦,这时我们可以使用Excel的VBA特性,打开VBA编辑器。

我们需要给要处理的表指派一个任务,这时我们可以建立子过程,建立的方式只要输入:

1
2
3
Sub Sample()
   ' TODO : 这里写执行代码
End Sub

这样我们就建立起名称为Sample的子过程,下面我们可以单击运行箭头,然后在宏列表中选择我们的子过程执行,不过现在没有代码,所以将不会有什么结果。

将上面的代码改成下面这样,再次运行,就可以看到消息框“Hello, World”。

1
2
3
Sub Sample()
   MsgBox "Hello, World"
End Sub

好了,下面需要给子过程指派指定的工作表,比如工作表名为Sheet1,下面几步建立起工作表的关联。

1
2
3
4
5
6
7
8
Sub Sample()
   Dim ws As Worksheet
   ' 设定ws引用Sheet1对象
   Set ws = Worksheets("Sheet1") 
   ws.Activate ' 激活指定的表
   ' TODO : 这里放对表操作的代码
   Set ws = Nothing ' 销毁对象引用
End Sub

两个常见的操作是设置行高(RowHeight)和列宽(ColumnWidth)。我们可以通过ActiveSheet.Rows(行数)获得指定行的对象,或者通过ActiveSheet.Columns(列数)获得列对象,那么行高和列宽的设置可以像下面这样:

1
2
3
4
5
6
7
8
9
10
11
Sub Sample()
   Dim ws As Worksheet
   ' 设定ws引用Sheet1对象
   Set ws = Worksheets("Sheet1")
   ws.Activate ' 激活指定的表
 
   ActiveSheet.Rows(1).RowHeight = 30
   ActiveSheet.Columns(1).ColumnWidth = 10
 
   Set ws = Nothing ' 销毁对象引用
End Sub

需要注意的是,行和列都是从1开始数起。

接下来就是对每个单元格的操作了,刚才我们设定ws引用Sheet1对象,那么单元格对象就是ws.Cells(行数, 列数)。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Sample()
   Dim ws As Worksheet
   Set ws = Worksheets("Sheet1") ' 设定ws引用Sheet1对象
   ws.Activate ' 激活指定的表
 
   Dim i As Integer
   For i = 1 To 50
      ' 设置第3列1~50行的单元格值
      ws.Cells(i, 3).Value = 0
      ' 设置第4列1~50行的单元格文本
      ws.Cells(i, 4).Text = "hi"
   Next i
 
   Set ws = Nothing ' 销毁对象引用
End Sub

好的先介绍这么多,如果大家想深入研究,不妨参阅《Microsoft Excel Visual Basic参考》

利用Scripting.FileSystemObject组件来枚举文件

基本的算法思想就是首先获得文件夹下的文件集合,然后枚举文件,然后再获得文件夹下子文件夹的集合,然后递归枚举,实际操作时为了更好的模块化,使用了回调函数,如果找到文件就自动交给指定函数处理,我们约定函数的格式如下:

FUNCTION(FileSystemObject, FileObject, Parameter) RETURN AS BOOL

首先第一个参数是FileSystemObject,就是将创建好的Scripting.FileSystemObject对象传入函数让我们加以利用。
其次第二个参数是FileObject,也就是枚举出的单独文件对象,我们可以通过这个对象获得文件一系列的属性和方法。
最后一个参数是Parameter,是在调用枚举时传入的参数,没有特殊需要可以忽略。
返回值,如果返回TRUE则中止枚举,否则将继续枚举直到枚举结束。

VBScript实现如下。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Class FileOperation
 
    Private AxFile   
    Private Sub Class_Initialize()
        Set AxFile = WSH.CreateObject("Scripting.FileSystemObject")
    End Sub
 
    Private Sub Class_Terminate()
        Set AxFile = Nothing
    End Sub
 
    Private Function GetSubFolders(strFolder)
        If AxFile.FolderExists(strFolder) Then
            Dim oFolders
            Set oFolders = AxFile.GetFolder(strFolder)
            Set GetSubFolders = oFolders.SubFolders
            Set oFolders = Nothing
        Else
            Set GetSubFolders = Nothing
        End If
    End Function
 
    Private Function GetSubFiles(strFolder)
        If AxFile.FolderExists(strFolder) Then
            Dim oFolders
            Set oFolders = AxFile.GetFolder(strFolder)
            Set GetSubFiles = oFolders.Files
            Set oFolders = Nothing
        Else
            Set GetSubFiles = Null
        End If
    End Function
 
    Public Function EnumFiles(strFolder, fCallBackName, Param)
        EnumFiles = True
        If Not AxFile.FolderExists(strFolder) Then
            EnumFiles = False
            Exit Function
        End If
 
        Dim fCallBack
        Dim SubFiles, SubFile, SubFolders, SubFolder
 
        Set fCallBack = GetRef(fCallBackName)
 
        Set SubFiles = GetSubFiles(strFolder)
        For Each SubFile In SubFiles
            If fCallBack(AxFile, SubFile, Param) Then Exit For
        Next
        Set SubFiles = Nothing
 
        Set SubFolders = GetSubFolders(strFolder)
        For Each SubFolder In SubFolders
            Call EnumFiles(AxFile.GetAbsolutePathName(SubFolder), _
                                  fCallBackName, Param)
        Next
        Set SubFolders = Nothing
 
        Set fCallBack = Nothing
    End Function
 
End Class

貌似VBScript没有函数指针的概念,在查阅了脚本手册后找到GetRef函数,用以根据字符串格式的函数名获取函数的引用,虽然看上去比较别扭,但是还是可以实现函数指针这个功能的。

JavaScript/JScript实现如下。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
function FileOperation() {
    this.self = WSH.CreateObject("Scripting.FileSystemObject");
 
    this.getSubFolders = function(fdr) {
        if (!this.self.FolderExists(fdr))
            return null;
        return (this.self.GetFolder(fdr).SubFolders);
    }
 
    this.getSubFiles = function(fdr) {
        if (!this.self.FolderExists(fdr))
            return null;
        return (this.self.GetFolder(fdr).Files);
    }
 
    this.enumFiles = function(fdr, callback, param) {
        if (!this.self.FolderExists(fdr))
            return false;
        var SubFiles = new Enumerator(this.getSubFiles(fdr));
        for (; !SubFiles.atEnd(); SubFiles.moveNext())
        {
            if (callback(this.self, SubFiles.item(), param))
                return true;
        }
        var SubFolders = new Enumerator(this.getSubFolders(fdr));
        for (; !SubFolders.atEnd(); SubFolders.moveNext()) {
            this.enumFiles(
            this.self.GetAbsolutePathName(SubFolders.item()),
            callback, param);
        }
        return true;
    }
}

JavaScript/JScript的将函数名作为变量传入很方便的实现了函数指针的功能,在这点上JavaScript/JScript的灵活性还是略胜一筹的,不过其foreach功能就没有VBScript那么好用了。

2012年3月21日更新

对VBScript类做了修改,增加了文件夹枚举搜索,增加递归开关,并且为了保证调用灵活,修改了回调原型函数。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
' Author : wangye
' http://wangye.org
Class FileOperation
 
    Private AxFile   
    Private Sub Class_Initialize()
        Set AxFile = WSH.CreateObject("Scripting.FileSystemObject")
    End Sub
 
    Private Sub Class_Terminate()
        Set AxFile = Nothing
    End Sub
 
    Private Function GetSubFolders(strFolder)
        If AxFile.FolderExists(strFolder) Then
            Dim oFolders
            Set oFolders = AxFile.GetFolder(strFolder)
            Set GetSubFolders = oFolders.SubFolders
            Set oFolders = Nothing
        Else
            Set GetSubFolders = Nothing
        End If
    End Function
 
    Private Function GetSubFiles(strFolder)
        If AxFile.FolderExists(strFolder) Then
            Dim oFolders
            Set oFolders = AxFile.GetFolder(strFolder)
            Set GetSubFiles = oFolders.Files
            Set oFolders = Nothing
        Else
            Set GetSubFiles = Null
        End If
    End Function
 
    ' EnumFiles 枚举指定文件夹文件
    '
    ' 回调函数原型为 CallBack(self, fso, file, param)
    '     self  Class FileOperation实例化对象
    '     fso   Scripting.FileSystemObject对象
    '     file  枚举到的文件对象
    '     param 传递给回调函数的参数(如果需要)
    '
    ' strFolder     要枚举的文件所在的文件夹
    ' fCallBackName 列出的每个文件所调用的回调函数名称
    ' Recursion     是否递归搜索
    ' Param         传递给回调函数的参数(如果需要)
    Public Function EnumFiles(strFolder, fCallBackName, Recursion, Param)
        EnumFiles = True
        If Not AxFile.FolderExists(strFolder) Then
            EnumFiles = False
            Exit Function
        End If
 
        Dim fCallBack
        Dim SubFiles, SubFile, SubFolders, SubFolder
 
        Set fCallBack = GetRef(fCallBackName)
 
        If TypeName(strFolder) = "Folder" Then
            Set SubFiles = strFolder.Files
        Else
            Set SubFiles = GetSubFiles(strFolder)
        End If
        For Each SubFile In SubFiles
            If fCallBack(Me, AxFile, SubFile, Param) Then Exit For
        Next
        Set SubFiles = Nothing
 
        If Recursion Then
        Set SubFolders = GetSubFolders(strFolder)
            For Each SubFolder In SubFolders
                Call EnumFiles(AxFile.GetAbsolutePathName(SubFolder), _
                          fCallBackName, Recursion, Param)
            Next
            Set SubFolders = Nothing
        End If
 
        Set fCallBack = Nothing
    End Function
 
    ' EnumFolders 枚举指定文件夹
    '
    ' 回调函数原型为 CallBack(self, fso, folder, param)
    '     self  Class FileOperation实例化对象
    '     fso   Scripting.FileSystemObject对象
    '     folder  枚举到的文件夹对象
    '     param 传递给回调函数的参数(如果需要)
    '
    ' strFolder     要枚举的文件夹所在的文件夹
    ' fCallBackName 列出的每个文件夹所调用的回调函数名称
    ' Recursion     是否递归搜索
    ' Param         传递给回调函数的参数(如果需要)
    Public Function EnumFolders(strFolder, fCallBackName, Recursion, Param)
        EnumFolders = True
        If Not AxFile.FolderExists(strFolder) Then
            EnumFolders = False
            Exit Function
        End If
 
        Dim fCallBack
        Dim SubFolders, SubFolder, ChildFolders, ChildFolder
 
        Set fCallBack = GetRef(fCallBackName)
        Set SubFolders = GetSubFolders(strFolder)
        For Each SubFolder In SubFolders
            If fCallBack(Me, AxFile, SubFolder, Param) Then Exit For
            If Recursion Then
                Set ChildFolders = SubFolder.SubFolders
                For Each ChildFolder In ChildFolders
                    If fCallBack(Me, AxFile, ChildFolder, Param) Then Exit For
                    Call EnumFolders(AxFile.GetAbsolutePathName(ChildFolder), _
                              fCallBackName, Recursion, Param)
                Next
                Set ChildFolders = Nothing
            End If
        Next
        Set SubFolders = Nothing
        Set fCallBack = Nothing
    End Function
End Class
 
' Example:
' Function ParseFiles(self, fso, file, param)
'     WSH.Echo file.Name & " at " & fso.GetAbsolutePathName(file)
' End Function
' Dim fp
' Set fp = New FileOperation
'     fp.EnumFiles "C:\", "ParseFiles", True, Null
' Set fp = Nothing

采用插件机制的批量文件扫描及进程处理工具

由于平常工作中需要大批量处理文件,所以用蹩脚的JavaScript语言编写了这个脚本,基本实现了文件及进程的枚举扫描,然后可以通过额外插件实现处理相应的文件或者进程,插件放在plugins文件夹里。

我这里写了3个插件,分别是批量打印Word文档、枚举系统活动进程、枚举RMVB、RM、AVI、WMV、MKV格式的电影文件。
[点击这里下载]

批量文件扫描及进程处理

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
function Component(ActiveXObject) {
 
  // 创建对象建议使用ActiveXObject.open(名称);
  // 比如ActiveXObject.open("Word.Application");
 
  this.name = "插件名称"; // 将显示在主界面下拉框中
  this.cancel = false; // 是否取消扫描,运行中设为true会自动中止扫描
  this.success = true; // 是否处理成功
  this.log = new Log(); // 日志对象
 
  // 日志分为3种,将会在列表框反应出来
  // this.log.error("出错消息文本");
  // this.log.info("正常消息文本");
  // this.log.warning("警告消息文本");
 
  this.load = function() {
    // 加载插件时所要运行的代码
  }
 
  this.unload = function() {
    // 卸载插件时所要运行的代码
  }
 
  this.dispatch = function(parentObj, selfObj, msg){
    switch(msg) {
      case "file": // 文件处理分支
      // parentObj.self (注意这里的.self)
      //就是Scripting.FileSystemObject对象
      // selfObj为每个File对象
      break;
      case "process": // 进程处理分支
      // parentObj 就是winmgmts的GetObject对象
      // selfObj为Win32_Process 每个进程对象
      break;
    }
    return false;
  }
}

目前已知的问题
1. 某些系统上双击启动会报错,请关闭IE浏览器并清除进程中多余的iexplore.exe进程后再试,如果错误依旧,请再次手动打开IE浏览器,然后再试。如果问题还是存在,建议关闭其他浏览器。(感谢威言威语提供)
2. 外文计算机上执行可能会出错,建议将脚本内中文改成英文后再运行。(感谢解皞在日文系统下的测试)

如果有什么问题或者建议欢迎提出!

WScript脚本打开文件夹选择对话框

最近在弄一些WScript脚本,有段功能需求就是弹出个打开文件夹的对话框,之前老是在”MSComDlg.CommonDialog“上纠结,后来才发现原来那个只能摆弄出文件选择对话框,后来在查阅了一些资料后才知道,要调用”Shell.Application“这个组件,哎,微软也应该把这些组件组合组合了,要不还真不容易找到。

文件夹浏览对话框

贴出部分代码,后来根据需要我还改写了JavaScript版本,话说JS的对象引用很是方便,不用像VBS那样Set对象了。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Const SHELL_MY_COMPUTER = &H11
Const SHELL_WINDOW_HANDLE = 0
Const SHELL_OPTIONS = 0
Function GetOpenDirectory(title)
	Dim ShlApp,ShlFdr,ShlFdrItem
 
	Set ShlApp = WSH.CreateObject("Shell.Application")
	Set ShlFdr = ShlApp.Namespace(SHELL_MY_COMPUTER)
	Set ShlFdrItem = ShlFdr.Self
	GetOpenDirectory = ShlFdrItem.Path
	Set ShlFdrItem = Nothing
	Set ShlFdr = Nothing
 
	Set ShlFdr = ShlApp.BrowseForFolder _
				(SHELL_WINDOW_HANDLE, _
				title, _
				SHELL_OPTIONS, _
				GetOpenDirectory)
	If ShlFdr Is Nothing Then
		GetOpenDirectory = ""
	Else
		Set ShlFdrItem = ShlFdr.Self
		GetOpenDirectory = ShlFdrItem.Path
		Set ShlFdrItem = Nothing
	End If
	Set ShlApp = Nothing
End Function
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
var SHELL_MY_COMPUTER = 0x11;
var SHELL_WINDOW_HANDLE = 0;
var SHELL_OPTIONS = 0;
 
function openDir(title) {
  var shlfdr,
  shlapp = WSH.CreateObject("Shell.Application");
 
  shlfdr = shlapp.BrowseForFolder(
			SHELL_WINDOW_HANDLE,
			title,
			SHELL_OPTIONS,
			shlapp.Namespace(SHELL_MY_COMPUTER).Self.Path);
  if (shlfdr == null)
     return "";
  return shlfdr.Self.Path;
}