VBA笔记与代码存档（转载）

(Last Updated On: 2021-05-13)

VBA – 标签 – 沙场秋点兵 – 博客园 (cnblogs.com)

性能优化

一、运行环境的优化

　　VBA是需要运行在运行环境中的，运行环境直接影响了VBA程序的执行效率，所以第一个方面，我们从干扰程序执行的因素，讨论运行环境的优化。
　　若要提高VBA程序的性能，明确禁用代码执行时不需要的功能是极其有效的优化方法。通常，只需在代码运行后重新计算或重绘一次，这样做可以提高性能。代码执行后，将功能恢复到其原始状态即可。

1.关闭屏幕更新（Application.ScreenUpdate = False/True）

　　关闭屏幕更新是提高VBA程序运行速度的很有效的方法，能大幅缩短运行时间。原因很简单，后台的操作不需要反映到屏幕上了，当然就省去了很多的操作，所以可以节省很多时间。当然了，这个操作是可以控制粒度的，比如每次VBA程序的开始于结束可以设置屏幕更新，也可以在每个循环的开始与结束时设置，这个通常取决于用户的需要。

2.关闭自动计算（Application.Calculation = xlCalculationManual/xlCalculationAutomatic）

　　函数的自动计算对Excel运行影响很大，尤其是有大量数组函数和易失性函数时，影响更为明显。这个方面优化的最简单的方法就是关闭自动重算，启用手动重算。通过减少重算量提高Excel速度。可以在进入主程序运行前，将计算模式设置为手动。Calculation 属性是对所有工作簿进行的设置，您也可以用工作表的EnableCalculation属性来设置对某个工作表是否进行重新计算。

3.禁用事件（Application.EnableEvents = False/True）

　　禁用事件可以避免事件触发时的连锁反应。例如在工作表的Change事件中，一个单元格的值改变影响两个以上的单元格值改变，因为事件的连续触发可以造成CPU耗尽。

4.禁用状态栏（Application.DisplayStatusBar=False/True）

　　状态栏设置与屏幕更新设置是分开的，这样即使屏幕不更新，您仍可以显示当前操作的状态。但是，如果您不需要显示每个操作的状态，则在代码运行时禁用状态栏也可以提高性能。

5.禁用分页符

　　如果 ActiveSheet.DisplayPageBreaks 设置为False，则 Excel 不显示分页符。代码运行时不需要重新计算分页符，在代码执行后计算分页符可以提高性能。

6.避免在频繁的事件中写代码

　　这个道理很简单，例如频繁的Activate事件。

二、算法的优化

　　算法代表解决问题的步骤，它直接影响了程序的执行效率，所以算法优化基本是所有语言优化代码最主要的过程；这是一个不断试验，不断总结，不断优化的过程。这个不是这里的重点，所以只是简单分享一下我知道的方式。
深刻挖掘和应用数学模型的特性
基本上都是缩小问题的规模，递推总结出数学模型的规律，然后用程序实现就可以了。例如下面的经典问题：
上台阶问题：http://www.cnblogs.com/flowerszhong/archive/2011/09/14/2176374.html。

如果空间允许的话，可以拿空间换时间
常见空间换时间算法：http://bbs.pfan.cn/post-227818.html

保存可以利用的中间结果
动态规划中用的最多了：http://www.cs.pitt.edu/~ztliu/wordpress/2011/04/algo-dynamic-programming/

采用合适的排序算法
海量数据查找：http://blog.csdn.net/lanphaday/article/details/3547776
常见排序算法：http://blog.csdn.net/ctang/article/details/37914

经常查询的集合数据，先排序
通常对于不怎么变化，但是又经常查询的数据，先排序是非常合算的，下面这个介绍了最快排序与最快搜索：http://blog.csdn.net/shendl/article/details/4053853

三、实现方式的优化

　　算法确定以后，就是使用具体的代码实现算法，而对于同样的算法，使用不同的函数去完成，也会有不小的差异，这方面其实基本都是从减少内存使用量，加速编译器的执行的速度这两个方面优化代码。

1、合理使用变量与常量

(1)始终声明和使用大小合适的变量类型，这个原因很明显，可以节省内存，加速运行速度。
(2)除非确实需要，应避免使用浮点数据类型。尽管Currency数据类型更大，但它比 Single 数据类型快，因为Currency数据类型不使用浮点处理器。
(3)如果在一个过程中多次引用一个对象，可以创建对象变量，并将对给对象的引用指派给它。因为对象变量存储对象在内存中的位置，VBA将不必再次查找其位置。
(4)尽可能使用早期绑定，这样不仅方便编码，更方便编译器查找成员。
　　绑定是指将程序调用与实际代码相匹配。为了实现早期绑定，先应创建对对象库的引用(这个我们在前面的COM对象使用中见得太多了)。早期绑定可以在代码中使用定义在对象库中的常量，可以自动列出对象的方法和属性。但早期绑定只有在所控制的对象拥有独立的类型库或对象库文件才适用且还需要已安装了特定的库。而后期绑定则只是在运行时才知道对象的类型并对对象进行引用，因此不具备上述特点。
　　使用早期绑定创建对象通常更有效率，使代码能获得更好的性能。因为对象的早期绑定引用在编译时可以通过VBE的解析，而不是通过运行时模块解析，因此早期绑定的性能要好得多。虽然在程序设计时不可能总是使用早期绑定，但应该尽可能使用它。
(5)多次使用的数值尽量定义成常量，易于修改，易于查找。
(6)减少变量的作用范围并及时释放变量(特别是对象实例，对于Recordset的使用，我们已经见过多次了)

Dim AnObj As New AnyObject 
'使用对象...
Set AnObj=Nothing ‘释放对象变量

2、尽量使用VBA内置函数与工作表函数

　　充分利用VBA内置函数与WorksheetFunction中的函数是提高程序运行速度的极度有效的方法。

如求平均工资的例子：

For Each c In Worksheet(1).Range(″A1:A1000″)
　　TotalValue = TotalValue ＋ c.Value
Next
AverageValue = TotalValue / Worksheet(1).Range(″A1:A1000″).Rows.Count

而下面代码程序比上面例子快得多：

AverageValue=Application.WorksheetFunction.Average(Worksheets(1).Range(″A1:A1000″))

其它函数如Count,Counta,Countif,Match,Lookup等等，都能代替相同功能的VBA程序代码，提高程序的运行速度。

3、尽量使用Range对象的SpecialCells，AutoFill，Formula等方式，替换循环单元格的做法

例如快速填充空行：

Sub Fill()
  Selection.SpecialCells(xlCellTypeBlanks) = "=r[-1]c"
End Sub

4、尽可能使用For Each…Next循环集合

　　可以使用For Each…Next循环来保证程序代码更快地执行。在使用For Each…Next循环时，对于存储在集合或数组中的每个对象执行一组语句，程序更简洁，也更容易阅读、调试和维护。当For Each…Next语句迭代集合时，自动指定一个对集合当前成员的引用，然后在到达集合的尾部时跳出循环语句。

5、尽可能在执行循环时节省资源

(1)把与循环无关的操作拿出去。例如，是否可以在循环外(而不是在循环中)设置某些变量？每次都通过循环执行的转换过程是否可以在循环之外执行？
(2)考虑尽早退出循环。例如，假设正在对一个不应该包含数字字符的字符串进行数据验证。如果循环要检查字符串中的每个字符以确定其中是否包含数字字符，那么您可以在找到第一个数字字符时立即退出循环。
(3)如果必须在循环中引用数组的元素，可以创建一个临时变量存储该元素的值，而不是引用数组中的值。从数组中检索值比从相同类型的变量读取值要慢的多。
(4)有可能的话，减少循环的步长，也就是减少循环的次数。
　　当使用有针对性的For循环，即仅仅需要对循环对象中的部分对象进行操作时，应该调整循环的步长来减少循环的次数。
对比下面两个循环：

For i = 1 To 10000
    If i Mod 2 = 1 Then Cells(i, 1).EntireRow.Interior.ColorIndex = 23
  Next i

For i = 1 To 10000 Step 2
     Cells(i, 1).EntireRow.Interior.ColorIndex = 23
Next i

实现同样的功能，但却循环的次数有差异，明显是第二个循环效率更高。

6、一次性完成赋值与粘贴

　　在使用Copy方法时，可以在一个语句中指定复制的内容及要复制到的目的地。
例如：

Range("B5:C6").Select 
Selection.Copy 
Range("B8").Select 
ActiveSheet.Paste

经修改后的最佳代码是：

Range("B5:C6").Copy Destination:=Range("B8")

7、选用合适的操作符，加速对数字的运算

(1)当对整数进行除法时，您可以使用整型除法运算符()而不是浮点除法运算符(/)，因为无论参与除法运算的数值类型如何，浮点除法运算符总会返回Double类型的值。
(2)在任何具有整数值的算术表达式中使用Single或Double值时，整数均将被转换成Single或Double值，最后的结果将是Single或Double值。如果要对作为算术运算结果的数字执行多次操作，可能需要明确地将该数字转换为较小的数据类型。

8、提高字符串操作的性能

(1)尽可能少使用连接操作。

　　连接操作符很多时候可以使用Replace，Mid函数代替。例如，可以在等号左边使用Mid函数替换字符串中的字符，而不是将它们连接在一起。注意，使用Mid 函数的缺点是替换字符串必须与要替换的子字符串的长度相同。

Dim strText As String 
strText = "this is a test" 
Mid(strText, 11, 4) = "tent"

(2)VBA提供许多可用来替换函数调用的内部字符串常量。

例如，可以使用vbCrLf常量来表示字符串中的回车/换行组合，而不是使用Chr(13) & Chr(10)。

(3)字符串比较操作的执行速度很慢。

　　在VBA 中，可以使用Chr$()函数把数转换成字符，并确定ANSI的值，也可以使用Asc()函数把字符串转换成数值，然后确定它的ANSI值。如果需要进行有限次数的这种检验，对程序代码的效率可能不会产生很大影响，但是，如果需要在多个循环内进行这种检验时，这将节省处理时间并且有助于程序代码更快地执行。 例如，下列代码会检查字符串中的第一个字符是否为空格：

If Asc(strText) = 32 Then

上面的代码会比以下代码更快：

If Left(strText, 1) = " " Then

(4)、使用Len()检验空串

　　尽管有多种方法可检验空串，但首选的是使用Len()函数。为了测试零长度的串，可以选择把串与””相比较，或者比较串的长度是否为0，但这些方法比用Len()函数要用更多的执行时间。当对字符串应用Len()函数并且函数返回0值时，说明该字符串是空的或者是零长度的字符串。 并且，因为在If语句内非零值被认为是True，所以直接使用Len()函数而不必与””或0比较，减少了处理时间，因此执行更快。

(5)、善用带$的字符串处理函数

　　在VBA中，有两套字符串处理函数，包含带”$”和不带”$”的函数，例如mid 和mid$，Left 和Left$,Right 和Right$。如果不使用带”$”符号的函数计算字符串，那么VBA将字符串作为Variant类型来进行计算，而使用带”$”的函数时，则将字符串当作string类型来进行计算，显示Variant型数据在计算时需要更多的内存空间。
如下面两句代码：

Str=mid("Wise",2)
Str=mid$("Wise",2)

第二句在执行效率上会占优势。

9、只要有可能就使用集合索引值

　　我们能在集合中使用名称或者数字来指定某个单一的对象，但使用对象的索引值通常是更快的。如果您使用对象的名字，VBA必须解析名字成为索引值；但如果您使用索引值，就能避免这个额外的步骤。
　　但另一方面，我们要注意到在集合中通过名称指定对象有很多优点。使用对象名称能使您的代码更容易阅读和调试。此外，通过名称指定一个对象比通过索引值更安全，因为当您的代码运行时该对象的索引值可能变化。例如，某菜单的索引值表示它在菜单栏中的位置，但是如果在菜单栏中添加了菜单或者删除了菜单，该菜单的索引值会变化。这样，您就不应该考虑代码的速度，而应保证代码运行可靠。您使用索引值加快代码速度之前，应该确保该索引值在代码运行过程中或使用应用程序时不会改变。

分享一个代码优化的经典合集：http://club.excelhome.net/thread-509998-1-1.html

四、代码规范的优化

　　优化了算法，采用了合适的函数和对象实现了算法后，代码其实还是有优化的空间，比如编程习惯，代码风格等，下面从这些方面总结一下。

1、尽量减少无用的操作，如对象的激活和选择

事实上大多数情况下激活和选择操作都只是有一点视觉效果，但很遗憾这对于VBA来说不是必需的。例如：

Sheets(″Sheet3″).Select
Range(″A1″).Value = 100
Range(″A2″).Value = 200

可改为：

With Sheets(″Sheet3″)
　.Range(″A1″).Value = 100
　.Range(″A2″).Value = 200
End With

2、尽量减少使用对象引用，即减少“.”的使用，尤其在循环中

每一个Excel对象的属性、方法的调用都需要通过OLE接口的一个或多个调用，这些OLE调用都是需要时间的，减少使用对象引用能加快VBA代码的运行。例如

(1)使用With语句。

Workbooks(1).Sheets(1).Range(″A1:A1000″).Font.Name=″Pay″
Workbooks(1).Sheets(1).Range(″A1:A1000″).Font.FontStyle=″Bold″

则以下语句比上面的快：

With Workbooks(1).Sheets(1).Range(″A1:A1000″).Font
　　 .Name = ″Pay″
　　 .FontStyle = ″Bold″
End With

(2)使用对象变量。

　　如果你发现一个对象引用被多次使用，则你可以将此对象用Set 设置为对象变量，以减少对对象的访问。如：

Workbooks(1).Sheets(1).Range(″A1″).Value = 100
Workbooks(1).Sheets(1).Range(″A2″).Value = 200

则以下代码比上面的要快：

Set MySheet = Workbooks(1).Sheets(1)
MySheet.Range(″A1″).Value = 100
MySheet.Range(″A2″).Value = 200

(3)在循环中要尽量减少对象的访问。

For k = 1 To 1000
　Sheets(″Sheet1″).Select
　Cells(k,1).Value = Cells(1,1).Value
Next k

则以下代码比上面的要快：

Set TheValue = Cells(1,1).Value
Sheets(″Sheet1″).Select
For k = 1 To 1000
　Cells(k,1).Value = TheValue
Next k

3、有效地使用数组与变量，尽量少使用单元格直接参与计算

　　通常单元格的操作都比较慢，可以先将单元格的值读入变量或数组变量，对变量进行运算，这样可以提高处理的速度。处理结束以后，只要用一个语句就可以将数组中的数据传递回单元格区域中。
　　在创建已知元素的确定数组时，使用Array函数对于节约空间和时间以及写出更具效率的代码是非常理想的。例如：

Dim Names As Variant 
Names=Array(“Fan”,“Yang”,“Wu”,“Shen”)

此外，应该尽量使用固定大小的数组。如果确实选择使用了动态数组，应该避免数组每增加一个元素就改变一次数组的大小，最好是每次增加一定数量的元素。

下面是一些扩展读物，有兴趣的同学可以试试看：

一个遍历大范围Range的各种方法的比较：http://www.vbafan.com/2009/01/22/what-is-the-fastest-way-to-scan-a-large-range-in-excel/

Excel2010性能的改进：http://msdn.microsoft.com/zh-cn/library/ff700514.aspx

提高Excel2010的计算性能：http://msdn.microsoft.com/zh-cn/library/ff700515.aspx

Excel2010性能优化提示：http://msdn.microsoft.com/zh-cn/library/ff726673.aspx

实战常用自定义函数

VBA中很多的功能可以用内置的函数完成，其它的可以自己写函数完成。下面几点就是我在实战中遇到比较多的，而且带有一定困惑性的典型问题。

返回列的名字

这是个最简单的问题，但是有时候还是很需要的，方法比较简单，就是通过Address获取列的名字，比如“A”，“AB”等。

Private Function columnHeader(Target As Range) As String
    columnHeader = Left$(Right$(Target.Address, Len(Target.Address) - 1), InStr(1, Right$(Target.Address, Len(Target.Address) - 1), "$") - 1)
End Function

寻找实际使用的最后一行

这个问题在实际中经常遇到，而且实现的方式也多种多样。

使用ExecuteExcel4Macro实现
　　在Excel VBA中，内置函数ExecuteExcel4Macro用于执行一些Excel 4.0中的一些函数。其中有一个特殊的函数是返回Sheet使用的最后一行的，使用很简单，如下所示：

Sub ShowLastLine()
    MsgBox ExecuteExcel4Macro("GET.DOCUMENT(10)")
End Sub

Application.ExecuteExcel4Macro的用法说明：
作用：执行一个 Microsoft Excel 4.0 宏函数，然后返回此函数的结果。返回结果的类型取决于函数的类型。
语法：ExecuteExcel4Macro(String)
参数：String，一个不带等号的 Microsoft Excel 4.0 宏语言函数。所有引用必须是像 R1C1 这样的字符串。如果 String 内包含嵌套的双引号，则必须写两个。例如，要运行宏函数 =MID(“sometext”,1,4)，String 必须为 “MID(“”sometext””,1,4)”。
返回值：Variant
说明：Microsoft Excel 4.0 宏不在当前工作簿或工作表的环境中求值。也就是说所有的引用都应该是外部引用，而且需要明确指定工作簿名。例如，要在 Book1 中执行 Microsoft Excel 4.0 宏“My_Macro”，必须使用“Book1!My_Macro()”。如果不指定工作簿名，此方法将失效。
示例：本示例对工作表 Sheet1 上的 C3 单元格执行 GET.CELL(42) 宏函数，然后在一个消息框中显示结果。GET.CELL(42) 宏函数返回当前窗口左边界到活动单元格的左边之间的水平距离。Visual Basic 中没有与此宏函数直接等价的函数。

Worksheets("Sheet1").Activate
Range("C3").Select
MsgBox ExecuteExcel4Macro("GET.CELL(42)")

使用End属性
　　在ExcelVBA中，使用End(xlUp)查找最后一行是最常使用且最为简单的方法，它假设要有一列总包含有数据(数字、文本和公式等)，并且在该列中最后输入数据的单元格的下一行不会包含数据，因此不必担心会覆盖掉已有数据。但该方法有两个缺点：
(1) 仅局限于查找指定列的最后一行。
(2) 如果该列中最后一行被隐藏，那么该隐藏行将被视作最后一行。因此，在最后一行被隐藏时，其数据可能会被覆盖。但该列中间的隐藏行不会影响查找的结果。

Public Function LastRowInColumn(Column As String) As Long
     LastRowInColumn = Range(Column & Rows.Count).End(xlUp).Row
End Function

使用Find方法
　　Find方法在当前工作有数据中进行查找，不需要指定列，也可以确保不会意外地覆盖掉已有数据。其中，参数LookIn指定所查找的类型，有三个常量可供选择，即xlValues、xlFormulas和xlComments。
(1) 常量xlFormulas将包含零值的单元格作为有数据的单元格。(当设置零值不显示时，该单元格看起来为空，但该参数仍将该单元格视为有数据的单元格)
(2) 常量xlValues将包含零值的单元格(如果设置零值不显示时)作为空白单元格，此时，若该单元格在最后一行，则Find方法会认为该单元格所在的行为空行，因此，该单元格中的内容可能会被新数据所覆盖。(在Excel中，选择菜单“工具”——“选项”，在打开的“选项”对话框中，选择“视图”选项卡，将其中的“零值”前的复选框取消选中，则工作表中的零值都不会显示)
　　如果在参数LookIn中使用常量xlValues的话，还存在一个问题是：如果您将最后一行隐藏，则Find方法会认为倒数第二行是最后一行，此时您在最后一行的下一行输入数据，则会将实际的最后一行的数据覆盖。

Find方法中，参数LookIn的默认值为xlFormulas。

Public Function LastRow() As Long
  '使用常量xlFormulas，因为常量xlValues会忽略隐藏的最后一行
  LastRow = Cells.Find("*", LookIn:=xlFormulas, SearchDirection:=xlPrevious).Row
End Function

使用UsedRange属性
　　UsedRange方法可用于在工作表中已使用区域查找最后一行，该区域包括可能以前使用过的任何单元格，但现在其中的数据被删除了，比如目前的工作表中只有第1行至第5行共5行，其它行都无数据，但在第6行中有些单元格以前使用过(可能仅仅格式化或内容清除了，总之该行现在不含有数据)，那么第6行也包含在该已使用的区域中。此外，如果最后一行被隐藏，那么会将因此，使用该方法查找最后一行是无规律且不可靠的，它通常可能会得到预料不到的结果。

Public Function LastUsedRow() As Long
  With ActiveSheet
    LastUsedRow =.UsedRange.Rows.Count + .UsedRange.Row - 1
  End With
End Function

使用SpecialCells方法
　　也可以用SpecialCells方法实现查找最后一行，其常量xlCellTypeLastCell代表在”已使用区域”中的最后一个单元格，与UsedRange属性稍有不同的是，当您在最后一行中输入数据后，又将其删除，则此数据所在的单元格也包含在已使用的区域中，并且如果最后的行被隐藏，则将可见行的最后一行当作最后一行。

Public Function LastUsedRow() As Long
  LastUsedRow = Cells.SpecialCells(xlCellTypeLastCell).Row
End Function

SpecialCells方法用于查找指定类型的值，其语法为SpecialCells(Type,Value)，有两种主要的使用方式：
(1) 若参数Type仅考虑常量，则在查找时会忽略和覆盖由公式生成的任何数据。
(2) 若参数Type仅考虑由公式生成的数据，则在查找时会忽略和覆盖任何常量数据。
　　如果参数Type是xlCellTypeConstants或者是xlCellTypeFormulas，则Value参数可使用常量决定哪种类型的单元格将被包含在结果中，这些常量值能组合而返回多个类型，其缺省设置是选择所有的常量或公式，而不管是何类型，可使用下面四个可选的常量：

  • 1) xlTextValues(包含文本);
  • 2) xlNumbers(包含数字);
  • 3) xlErrors(包含错误值);
  • 4) xlLogical(包含逻辑值);

　　我们可以使用SpecailCells方法去找到其它特定类型的单元格所在的最后一行，下面是这些常量的一个完整的列表：

  1. XlCellTypeAllFormatConditions (任何格式的单元格)
  2. XlCellTypeAllValidation (带有数据有效性的单元格)
  3. XlCellTypeBlanks (所使用区域中的空白单元格)
  4. XlCellTypeComments (包含有批注的单元格)
  5. XlCellTypeConstants (包含有常量的单元格)
  6. XlCellTypeFormulas (包含有公式的单元格)
  7. XlCellTypeLastCell (已使用区域中的最后一个单元格(看下面))
  8. XlCellTypeSameFormatConditions (有相同格式的单元格)
  9. XlCellTypeSameValidation (有相同数据有效性条件的单元格)
  10. XlCellTypeVisible (工作表中所有可见的单元格)

使用CurrentRegion属性
　　Range对象的CurrentRegion属性返回代表单元格所在的当前区域，即四周有空行的独立区域，因此，可使用此属性查找当前区域的最后一行。但是使用其查找最后一行的一个缺点是，必须首先选取当前区域，然后进行查找。

自定义类型扩展

　　VBA中扩充基本类型的基本手段就是自定义类型，主要有两种方式。

1.定义Type

　　使用Type关键字可以定义一些简单的自定义类型，这些类型使用起来就像基本类型一样使用，直接定义和赋值。例如：

Public Type Employee
    Name As String
    Address As String
    Salary As Double
End Type

Dim Manager As Employee
Manager.Name = "Joe Smith"
Manager.Address = "123 Main Street"
Manager.Salary = 40000

Type定义和使用都很简单，但是它只是一种静态的数据结构，无法完成很多高级的功能；它的显著缺点如下：

  1. 无法创建Type的实例，可以存放到数组中，但是无法存放到Collection与Dictionary中。
  2. 无法控制成员的有效范围，也就是无法验证成员的值是合法的。
  3. 只有数据，无法去定义行为。

2.定义Class

正是由于Type简单但是难以胜任复杂的情景，所以当需要一些负责的处理数据的场景时，往往需要定义Class这种更强大的扩展。定义Class的方式也很简单，直接在工程中插入一个Class Module就可以了，可以在属性窗口中设置Class的名字。下面是示例：

Private pName As String
Private pAddress As String
Private pSalary As Double

Public Property Get Name() As String 
    Name = pName 
End Property 
Public Property Let Name(Value As String) 
    pName = Value 
End Property 

Public Property Get Address() As String 
    Address = pAddress 
End Property 
Public Property Let Address(Value As String) 
    pAddress = Value 
End Property 

Public Property Get Salary() As Double 
    Salary = pSalary 
End Property 
Public Property Let Salary(Value As Double) 
    If Value > 0 Then
          pSalary = Value 
    Else
        ' appropriate error code here
    End If
End Property 

'使用例子
Dim Emp As CEmployee
Set Emp = New CEmployee
Emp.Name = "Joe Smith"
Emp.Address = "123 Main Street"
Emp.Salary = 40000
  • Class是更为高级的对象，它带来的良好的封装性，也带来了一定的复杂性。所以只应该对那些具有行为，重用性高的数据建模成Class。
  • Class需要使用New关键字去创建新实例，而且需要使用Set关键字去赋值。
  • 使用Type经常会遇到(传递参数，存放到集合等等)的一个错误是”Only user-defined types defined in public object modules can be coerced to or from a variant or passed to late-bound functions.”。这个时候，需要定义一个Class去完成相关功能，而不是去定义一个Type。

异常捕获

主流的开发语言，基本上都提供了类似于try/catch的异常处理机制；某些语言，例如C++与Jave，甚至还可以为函数声明可能出现的异常。这些手段结合起来基本上可以把异常消弭在萌芽状态，还程序一个安全的运行空间。

其实有时候我们可以利用异常，达到我们其他的目的，比如激活Worksheet那个，我们可以间接判断出那个Worksheet存不存在。我们可以通过这种变相的方式可以实现一些查询的目的。但是通常，能用其他简单方式去实现的，尽量不要使用异常处理去实现类似功能。

使用保卫语句，尽量避免出现异常

异常，通常指的是程序处于未定义的状态，执行未定义的行为。在大多数情况下，程序的状态都在我们的控制之中，对于一些异常的情况，我们也是可以预料到的，并可以辅助以各种判断语句加以保护，避免异常的出现；这些语句通常就叫做“保卫语句”。采用“保卫语句”，我们可以避免大部分异常情况，这是程序设计中很常用的一项技巧。毕竟异常是程序的非法状态，不仅异常处理语句的执行效率很低，而且需要我们耗费很多的时间去调试和处理。所以如果有可能事先处理掉错误和异常，这对于程序的开发和执行都是相当有益的。

VBA可以提前编译，发现部分异常

VBA程序可以在运行前编译一下，这时某些异常是可以提前发现的，比如变量类型没有定义的情况(Option Explicit开启的时候)。做法是在VBA编辑器中，点击“Debug”下面的“Compile VBAProject”菜单就可以编译一下程序。

VBA中的异常处理

使用保卫语句，我们能避免相当一部分异常，但是还是有很多其它的异常，我们是难以预料的。所以还需要设计其它的途径捕获这些错误。在VBA中可以使用On Error语句和Resume语句处理异常。

On Error语句的3种形式

  1. On Error Goto 0
    • 是VBA的默认模式。使用它的时候，一旦遇到运行时的错误，它就显示一个标准的错误信息对话框，告诉用户错误的类型并可以进行调试。这是VBA的默认行为，与没有设置异常处理是一样的。所以一般并没有人使用。
  2. On Error Resume Next
    • 是比较常用，但是也常常误用的一种方式。使用这种形式的时候，一旦遇到错误，它就跳到错误发生位置的下一行继续执行。这个时候如果出错的情况并不影响程序的正常功能，我们可以修复并跳过去执行；但是更多的等情况是，我们需要使用的很多状态是与出错的语句是相关的，不能直接跳过。这个时候，我们可以测试Err对象的Number属性是否等于0来判断出现的问题，并妥善解决。
  3. On Error Goto :
    • 是最常用的方式。这个语句告诉VBA，当出现异常的时候，跳到Label标识的异常处理块去执行。
    • 请注意Exit Sub语句的作用，它会隔开正常的程序流程与异常处理块。
    • Label标识的通常就是异常处理语句，这些语句是用于解决程序的问题并继续执行程序。 通常不可以使用这种方式简单的去跳过几行语句。例如下面的语句是不能工作的：
On Error GoTo Err1:
    Debug.Print 1 / 0
    ' more code
Err1:
    On Error GoTo Err2:
    Debug.Print 1 / 0
    ' more code
Err2:

当第一个错误发生的时候，程序跳到Err1位置执行，这个时候异常处理正在继续，如果这个时候遇到第二个异常，第二个异常是不会被On Error 语句捕获的。

Resume语句的3种形式

Resume语句是指示程序到指定的位置继续执行。它只可以在异常处理块中使用，在程序其它位置使用时非法的。

  1. Resume
    • 单独使用Resume的时候， 程序会在出错的位置继续执行。所以应该要保证错误已经被修复；否则的话，程序可能会陷入死循环中。
  2. Resume Next
    • 使程序从出错的位置的下一行继续执行。
  3. Resume <label>:
    • 指示程序跳到指定的位置继续执行

Resume的使用场景：激活一个不存在的Worksheet，在异常处理块中修复了问题并从出错位置继续执行。

On Error GoTo ErrHandler:
    Worksheets("NewSheet").Activate 
    Exit Sub

ErrHandler:
    If Err.Number = 9 Then
        ' sheet does not exist, so create it
        Worksheets.Add.Name = "NewSheet"
        ' go back to the line of code that caused the problem
        Resume
    End If

Resume Next的使用场景

On Error GoTo ErrHandler:
    N = 1 / 0
    Debug.Print N
    Exit Sub
ErrHandler:
    N = 1
    ' go back to the line following the error
    Resume Next

Resume <label>的使用场景

On Error GoTo ErrHandler:
    N = 1 / 0
    ' code that is skipped if an error occurs
Label1:
    ' more code to execute
    Exit Sub
ErrHandler:
    ' go back to the line at Label1:
    Resume Label1:

通用异常处理函数

使用On Error语句可以处理每个函数的异常，但是对于一个程序，出错的可能性就是那么几种，很多时候都是重复在处理这几个异常。这个时候，可以提供一个公用的异常处理函数，如下面例子所示：

Public Function ErrorsHandle() As Integer
   '错误处理情况
   Select Case Err.Number
          Case '生成错误信息...
          Case Else
                   '...
   End Select
     
   '询问用户 
   dialogResult = MsgBox(...)
   Select Case dialogResult 
          Case 4, 6             ' Retry And Yes
             ErrorsHandle = 0
          Case 5                ' Ignore
             ErrorsHandle = 1
          Case Else             ' Cancel and Abort
             ErrorsHandle = 2
   End Select
End Function    

Private Sub Sample()  
        On Error GoTo Error_Handle
    '...
    Exit Sub    
Error_Handle:
    errNum = ErrorsHandle
    If errNum = 0 Then
        Resume
    ElseIf errNum = 1 Then
        Resume Next
    Else
        Exit Sub
    End If
End Sub

数据输入、输出、验证、正则表达式

数据输入

Msgbox：最简单的用户输入框

MsgBox(Prompt[,Buttons][,Title][,Helpfile,Context]) As Integer

用户的输入就是他选择的按钮，也就是Integer值所代表的选项。这里用户的选择比较简单，所以不用验证。

InputBox：最简单的全能型用户输入框

VBA内置的InputBox方法

这个函数返回一个字符串，选择取消后返回空串(零个字节的字符串)。它不含有容错处理。例如你想要用户输入整数，结果用户输入了字符，这个时候InputBox并不会替你告诉用户错误的原因。

Application的InputBox函数

这个函数更强大，内置容错处理，选择取消后返回false。这个函数可以指定输入的类型，当用户输入的数据类型与参数中指定的类型不兼容的时候，这个函数会给出温馨的提示，告诉你输入的数据类型不对。

单元格输入

这种方式是最常见的，用户在单元格中输入数据，然后程序获取单元格中数据并处理。

用户窗口输入

这种方式最直观，比较适合处理结构化数据；利用窗口，我们可以提供专业的用户视觉体验和便利的用户输入体验。

文件输入

这种方式适合导入大量的数据或其它来源的数据。

数据输出

  1. Msgbox：最简单的输出信息方式。
  2. 单元格输出：可以显示大量的处理结果。
  3. 用户窗口输出：显示一些自定义的信息和格式，用户体验较佳。
  4. 文件输出：输出大量的信息和结果。
  5. 立即窗口输出：一般用于调试的时候显示信息(Debug.Print)。

数据验证

VBA内置的验证函数

  • IsNumeric(x) – 是否为数字, 返回Boolean结果。
  • IsDate(x) – 是否是日期, 返回Boolean结果。
  • IsEmpty（x） – 是否为Empty, 返回Boolean结果。
  • IsArray(x) – 指出变量是否为一个数组。
  • IsError(expression) – 指出表达式是否为一个错误值。
  • IsNull(expression) – 指出表达式是否不包含任何有效数据 (Null)。
  • IsObject(identifier) – 指出标识符是否表示对象变量。

WorksheetFunction内置的验证函数

  • IsErr – 检查是不是除了#N/A外的错误值.
  • IsError – 检查是不是错误值(#N/A, #VALUE!, #REF!, #DIV/0!, #NUM!, #NAME?,或者 #NULL!).
  • IsEven – 检查是否是偶数.
  • IsOdd – 检查是否是奇数.
  • IsLogical – 检查是不是布尔值.
  • IsNA – 检查值是否是错误值#N/A（值不可用）。
  • IsNonText – 检查是否是非文本(空的单元格返回true)。
  • IsNumber – 检查是不是数字。
  • IsText – 一般用于判断单元格中内容是否是文本。

正则表达式

正则表达式是通用的文本搜索和处理方案，它的知识不是VBA独有的，基本上每种语言都内置了正则表达式的功能。正则表达式的基础知识不是这里的重点，需要的朋友可以Google一下，或者参看下面的一些入门教程：
http://deerchao.net/tutorials/regex/regex.htm
http://www.regexlab.com/zh/regref.htm
http://www.williamlong.info/archives/433.html

创建正则表达式对象

  • 前期绑定：在VBA代码编辑器中的”Tools”菜单中，选中”References…”，然后引用Microsoft VBScript Regular Expressions 5.5类库，然后直接定义对象：Dim reg As New RegExp。
  • 后期绑定：使用CreateObject方法定义对象：CreateObject(“VBSCRIPT.REGEXP”)。
  • 前一种方式的优点是可以有编辑器的Intellisense支持。

RegExp对象的属性

  • Global – 设置或返回一个 Boolean 值，该值指明在整个搜索字符串时模式是全部匹配还是只匹配第一个。如果搜索应用于整个字符串，Global 属性的值应该为 True，否则其值为 False。默认的设置为True。
  • Multiline – 返回正则表达式是否具有标志m, 缺省值为False。如果指定的搜索字符串分布在多行，这个属性是要设置为True的。
  • IgnoreCase – 设置或返回一个Boolean值，指明模式搜索是否区分大小写。如果搜索是区分大小写的，则 IgnoreCase 属性应该为False；否则应该设为True。缺省值为True。
  • Pattern – 设置或返回被搜索的正则表达式模式。 被搜索的正则字符串表达式。它包含各种正则表达式字符。

RegExp对象的方法

  • Execute – 对指定的字符串执行正则表达式搜索。需要传入要在其上执行正则表达式的文本字符串。正则表达式搜索的设计模式是通过 RegExp对象的Pattern来设置的。Execute方法返回一个Matches集合，其中包含了在string中找到的每一个匹配的Match对象。如果未找到匹配，Execute将返回空的Matches集合。
  • Replace – 替换在正则表达式查找中找到的文本。
  • Test – 对指定的字符串执行一个正则表达式搜索，并返回一个 Boolean 值指示是否找到匹配的模式。RegExp.Global属性对Test方法没有影响。如果找到了匹配的模式，Test方法返回True；否则返回False。

MatchCollection对象与Match对象

匹配到的所有对象放在MatchCollection集合中，这个集合对象只有两个只读属性：

  • Count：匹配到的对象的数目
  • Item：集合的又一通用方法，需要传入Index值获取指定的元素。

一般，可以使用For Each语句枚举集合中的对象。集合中对象的类型是Match。
Match对象有以下几个只读的属性：

  • FirstIndex – 匹配字符串在整个字符串中的位置，值从0开始。
  • Length – 匹配字符串的长度。
  • Value – 匹配的字符串。
  • SubMatches – 集合，匹配字符串中每个分组的值。作为集合类型，有Count和Item两个属性。
Sub Test()
    Dim reg As New RegExp
    With reg
        .Global = True
        .IgnoreCase = True
        .Pattern = "\d+"
    End With
    Dim mc As MatchCollection
    Dim m As Match
    Set mc = reg.Execute("123aaaaa987uiiui999")
    For Each m In mc
        MsgBox m.Value
    Next
End Sub

爬虫

引用Microsoft HTML Object Library、Microsoft Internet Controls

以下地址提供了为000001(华夏混合成长）在成立以来2001年12月18日到2020年05月18日之间的基金净值数据。

http://fund.eastmoney.com/f10/F10DataApi.aspx?type=lsjz&code=000001&sdate=2001-12-18&edate=2020-05-18&per=20&page=1

链接中的各参数含义简单说明：
code=000001：基金代码000001；
sdate=2001-12-18：数据开始日期等于2001-12-18
edate=2020-05-18：数据结束日期等于2020-05-18
per：每页显示的条数，最大为50，为了便于演示，我设置为20条；
page：一页显示不完整，该参数直接指定显示第几页。

'测试成功
Option Explicit

Sub Test_Get_Nav()
Debug.Print Crawler_One_Fund_Nav("460005", "2021-01-2")
Debug.Print Crawler_One_Fund_Nav("460005", "2021-01-22")
Debug.Print Crawler_One_Fund_ANav("460005", "2021-01-2")
Debug.Print Crawler_One_Fund_ANav("460005", "2021-01-22")
End Sub

Function Crawler_One_Fund_Nav(FundCode As String, DateNav As String) As Variant
'获取指定基金在指定日期的单位净值
Dim S() As String, Reg As Object
    Set Reg = CreateObject("VBSCRIPT.REGEXP")
    Reg.Global = True
    Reg.Pattern = "</td><td[^>]*[>]"
Dim oHtml As Object
    Set oHtml = VBA.CreateObject("WinHttp.WinHttpRequest.5.1")
Dim sUrl As String
    sUrl = "https://fundf10.eastmoney.com/F10DataApi.aspx?type=lsjz&code=" & FundCode & "&sdate=" & DateNav & "&edate=" & DateNav & "&per=20&page=1"
    With oHtml
        .Open "GET", sUrl, False
        .send
        If InStr(.responseText, "暂无数据") > 0 Then
            Crawler_One_Fund_Nav = "暂无数据"
            Set Reg = Nothing
            Set oHtml = Nothing
            Exit Function
        End If
        Dim T() As String
        S = Split(Replace(.responseText, "</td></tr>", ""), "<tr><td>")
        T = Split(Reg.Replace(S(1), " "))
        Crawler_One_Fund_Nav = T(1) 'T(0)为日期，T(1)为单位净值，T(2)为累计单位净值，T(3)为日增长率
    End With
    Set Reg = Nothing
    Set oHtml = Nothing
End Function

Function Crawler_One_Fund_ANav(FundCode As String, DateNav As String) As Variant
'获取指定基金在指定日期的累计单位净值
Dim S() As String, Reg As Object
    Set Reg = CreateObject("VBSCRIPT.REGEXP")
    Reg.Global = True
    Reg.Pattern = "</td><td[^>]*[>]"
Dim oHtml As Object
    Set oHtml = VBA.CreateObject("WinHttp.WinHttpRequest.5.1")
Dim sUrl As String
    sUrl = "https://fundf10.eastmoney.com/F10DataApi.aspx?type=lsjz&code=" & FundCode & "&sdate=" & DateNav & "&edate=" & DateNav & "&per=20&page=1"
    With oHtml
        .Open "GET", sUrl, False
        .send
        If InStr(.responseText, "暂无数据") > 0 Then
            Crawler_One_Fund_Nav = "暂无数据"
            Set Reg = Nothing
            Set oHtml = Nothing
            Exit Function
        End If
        Dim T() As String
        S = Split(Replace(.responseText, "</td></tr>", ""), "<tr><td>")
        T = Split(Reg.Replace(S(1), " "))
        Crawler_One_Fund_Nav = T(2) 'T(0)为日期，T(1)为单位净值，T(2)为累计单位净值，T(3)为日增长率
    End With
    Set Reg = Nothing
    Set oHtml = Nothing
End Function

Sub Web_Crawler()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Cells.Clear
Dim url As String, i As Long, j As Long, n As Long, s() As String, t() As String, brr(1 To 10000, 1 To 7) As String, cel As Range, reg As Object, str As String

str = InputBox("请输入代码", "提示", 180031)
Set reg = CreateObject("VBSCRIPT.REGEXP")
    reg.Global = True
    reg.Pattern = "</td><td[^>]*[>]"
   
Dim p%
For p = 1 To 85

url = "http://fund.eastmoney.com/f10/F10DataApi.aspx?type=lsjz&code=" & str & "&page=" & p & "&per=2000"
With CreateObject("Microsoft.XMLHTTP")
    .Open "GET", url, True
    .send
While .ReadyState <> 4
    DoEvents
Wend

s = Split(Replace(.responsetext, "</td></tr>", ""), "<tr><td>")
For i = 1 To UBound(s)
     t = Split(reg.Replace(s(i), " "))
     n = n + 1
    For j = 1 To 7
        brr(n, j) = t(j - 1)
Next: Next: End With

Next


[a1:H1] = Split("序号 净值日期 单位净值(元) 累计净值(元) 日增长率 申购状态 赎回状态 分红送配 ")
[b2].Resize(n, 7) = brr
Set reg = Nothing
m = [b65536].End(3).Row
For Each cel In Range("a2:a" & m)
cel = cel.Row - 1
Next
    With Columns("A:g")
        .EntireColumn.AutoFit
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
For Each cel In Range("c2:e" & m)
    cel.Value = cel.Value
    cel.Style = "Comma"
    cel.NumberFormatLocal = "_ * #,##0.0000_ ;_ * -#,##0.0000_ ;_ * ""-""????_ ;_ @_ "
Next
 Range("e2:e" & m).NumberFormatLocal = "0.00%"
 Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "ok"
End Sub

遍历指定文件夹中的所有文件和子文件夹

'
Semi-finished Goods

Sub LINSHI()



    Const SearchPath = "D:\工作任务\1.Daily Work"
    
    Dim DicList, FileList, I, FileName(), FilePath()
    Dim Key, NowDic, NowFile
    Set DicList = CreateObject("Scripting.Dictionary")
    Set FileList = CreateObject("Scripting.Dictionary")
    
    DicList.Add SearchPath, ""  '初始化目录
    
    '**************遍历所有目录*******************
    I = 0
    Do While I < DicList.Count
        Key = DicList.Keys '本次要遍历的目录
        NowDic = Dir(Key(I), vbDirectory) '开始查找
        Do While NowDic <> ""
            If (NowDic <> ".") And (NowDic <> "..") Then
                If (GetAttr(Key(I)) And vbDirectory) = vbDirectory Then  '找到子目录，则添加
                    DicList.Add Key(I) & NowDic & "\", ""
                End If
            End If
            NowDic = Dir() '再找
        Loop
        I = I + 1
    Loop
    '****************************************************
    
    '**************遍历目录中的所有文件*******************
    For Each Key In DicList.Keys '查找所有目录中的文件
       NowFile = Dir(Key & "*.*")
       Do While NowFile <> ""
            FileList.Add NowFile, Key 'Add(Key,Item)  FileList.Key=文件名,FileList.Item=目录
            NowFile = Dir()
       Loop
    Next
    FileName() = FileList.Keys
    FilePath() = FileList.Items


End Sub

使用SQL查询字符串时，长度超过255时被截断

可能存在的原因为Excel使用ADODB操作时，默认会以前8行数据来判断整列的数据类型及结构，包括字符串的长度。如果第9行开始出现都大于前8行中最长的单元格内容时，将会被截断。

解决方案是需要修改注册表项“HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Jet\4.0\Engines\Excel\TypeGuessRows ”值为更大，但此参数只支持最大16（如果设置为0，则会扫描所有行，大数据时慎重）。

另外，也有其他同学遇到了插入数据库，发现字段被截断的问题，给出的解决方案是替换单元格内容中所有的单引号，因为单引号在数据库中作为关键字使用，可能内容被提前结束导致字段被截断。

Public Function FormatSql(ByVal strValue As String) As String
100 On Error GoTo errhandle
     
        Const TAG1 As String = "'"
        Const TAG2 As String = "''"
     
        '将一个单引号'替换成两人单引号''
        '如  a'b'c  --> a''b''c
        '    a''b   --> a''''b
102     FormatSql = Replace(strValue, TAG1, TAG2)
     
        Exit Function
     
errhandle:
104     Call PutLog( Erl, Err.Description)
End Function

字符串中双引号的处理

如 theStr = [MyName =“schunter”Class =“2”] ，如何将此字符串显示出来呢？

正确的写法是： theStr =“[MyName =”＆“”“”＆“schunter” “”“”“＆”Class =“＆”“”“＆”2“＆”“”“＆”]“ 也就是有引号的地方，需要两个引号才能生成一个引号。

InStrRev 函数的用法

InStrRev函数的理解其实很简单。
简单的理解是：在一个字符串内查找另一个字符串，使用的方法是“从字符串的尾部（右手边）开始找，如果找到了，但计数的方法却是从左往右，也就是找到后还是从左往右数字符串所在的位置（这个是方便程序员的使用的，因为很多时候取字符串时都是从左往右取）”。
InStr函数的查找方法是“从字符串的头部（左手边）开始找，计数的方法是从左往右”。
例如：从字符串“ABCDKEFGHIJKLMN”中查找字符“K”
用InStrRev函数的结果是12，指的是“ABCDKEFGHIJKLMN”
公式：InStrRev(“ABCDKEFGHIJKLMN”,”K”,,1)

用InStr函数的结果是5，指的是“ABCDKEFGHIJKLMN”
公式：InStr(“ABCDKEFGHIJKLMN”, “K”)

Dim TestString As String = "the quick brown fox jumps over the lazy dog"
Dim TestNumber As Integer
' Returns 32.
TestNumber = InStrRev(TestString, "the")
' Returns 1.
TestNumber = InStrRev(TestString, "the", 16)


Sub kkk()
s = "abba"
x = InStr(s, "a")      '         x=1
y = InStrRev(s, "a")'          y=4
End Sub

ADO为什么RecordCount属性返回-1

在这个论坛里第一次接触到ADO，对通过用ADO来获取数据库的数据，对我日常的工作来说真是太有用了，因此慢慢地开始编写一些ADO读取数据库的代码，用得越多，疑问也越多。ADO太灵活了，如对于从数据库获取数据，可以有很多的方法，即可以使用Recrodset对象来完成，也可以直接通过一个connection对象来完成；连接数据库也有多种方法，各种连接字符串又是什么涵义等，这些问题一直困惑着我，对于初学者来说ADO的灵活并不是件好事，会让我们迷惑，至少我当时学着用ADO时，有太多太多的问题，但这些问题又不好找答案。通过慢慢摸索，特别是当我从淘宝淘了一本二手的《ADO编程指南》（该书已经不再发行了）并仔细阅读了几遍后才对ADO有了越来越清晰的认识，一些以前的疑问也慢慢地解开了。现在空的时候还经常翻开读一段，随着对ADO理解地加深，一些以前不被注意到的细节也慢慢地有所理解，真的是温故而知新。
    最近在逛论坛时又看到一个关于“为什么RecordCount属性返回-1”的问题，这个问题当时也困惑着我，从帮助文件中了解到返回-1与游标类型有关，有的游标会返回-1。当时看了帮助后不但问题没解决，又出现了一些新的问题，什么是游标，什么是键集游标，什么是客户机端临时表等等。有人说最好的电脑书就是帮助，我觉得没错，但前提是你有一定的基础，因为帮助会用很简单的语言把一个问题描述清楚，如果你有太多的基础不清楚，那么帮助中的术语会让你看不下去。当时看ADO的帮助就是这种情况，现在对ADO有了一定的理解后回过头再去看ADO的帮助时，就发现帮助里的话可以说是字字精辟，有一些关键点就是在几个字中描述得清清楚楚。呵呵跑得有点远了。接下来进入正题吧。
其实有很多的问题如上面返回-1的问题，为什么有的游标对于别的用户对数据的修改可见，有的游标对于其他用户插入的数据可见等等问题都和游标类型有关。游标是数据库中一个十分重要的概念，是系统为用户开设的一个数据缓冲区，存放SQL语句的执行结果，它是一种用来存储查询结果的数据结构，游标应该和临时表是同一样东西（个人认为，因没有系统学过数据库，此处有不正请指正，接下来我就称游标为临时表了，这个称呼似乎更容易理解），当我们对数据库发出一条查询请求后，数据库返回的满足查询条件的记录会存放在临时存放在这种数据结构中。临时表有很多种，每种都有各自的特点，接下来我会分别介绍几中常用的临时表。

    在介绍临时表前先介绍两个ADO中属性。
    第一个属性是CursorLocation，该属性用于设定临时表的位置，我们经常使用的是以下两个值。AdUseServer为默认值，表示服务器端的临时表，使用OLE DB提供程序或数据库来管理查询结果；AdUseClient，客户机端临时表，使用ADO临时表引擎来管理查询结果。
    第二个属性是CursorType，该属性用来设定临时表的类型，有4个值。
        adOpenForwardOnly，正向临时表，服务器端Recordset的默认值，用于打开仅支持向前滚动的Recordset；
        adOpenStatic，静态临时表，客户机端默认的并且唯一可能的值，支持前向和后向滚动，其他用户所作的改动不可见；
        adOpenKeyset，键集临时表，支持前向和后向的滚动，其他用户的修改和删除可见；
        adOpenDynamic，动态临时表，支持前向和后向的滚动，其他用户的修改、删除和插入可见。
    再简单说一下什么是OLE DB提供程序，OLE DB提供程序是一种由C++开发的访问数据库的程序，它可以被C++直接调用，但不能被其他的语言所调用，因此在OLE DB的基础上又开发出了ActiveX Data Object(ADO)，它基于ActiveX技术，与语言无关，可以被多种语言所使用，因此我们可以在VBA中使用它，也可以在C++、C#、Delphi等程序设计语言中使用。
    根据临时表所在的位置（CursorLocation属性）不同可以分为服务器端临时表和客户机端临时表。我们如何来区分服务器端和客户机端呢？一般来说客户机直接面向的是用户，服务器是为计算机或其他程序提供支持的程序，因此并不是说服务器一定是指其他的电脑，很多情况下在同一台电脑即是服务器又是客户机。对于这们这里的临时表来说，我个人理解当临时表位于数据库与OLE DB提供程序之间时称为服务器端临时表，位置ADO与OLE DB提供程序之间的称为客户机端临时表。

    首先来介绍服务器端临时表吧。前面已经提到了当CursorLocation=AdUseServer时使用OLE DB提供程序或数据库来管理查询结果，先不讲这是什么意思，这里只要知道一点，那就是ADO默认使用服务器端的临时表。常用的服务器端临时表有正向临时表、静态临时表、键集临时表、动态临时表。
    1、正向临时表：也叫仅向前临时表CursorType=adOpenForwardOnly。正向临时表是最简单的一种临时表，就象它的名字一样，临时表中的记录只能向前移动，一旦移过某个记录，则该记录在临时表中就无效了。这种临时表功能较少，看上去作用有限，但速度极快。我们来看下面的示意图。

    图中临时表位于OLE DB提供程序与数据库之间，临时表可能是由OLE DB程序负责管理，也有可能是由数据库进行管理，这得看数据库和OLE DB提供程序来确定，如SQL Server就是由数据库来管理临时表的，而ACCESS则是由OLE DB提供程序来管理临时表。临时表中虚线部分表示已经读取过的记录，黄色部分表示当前读取到ADO缓存的记录。在Recrodset中有一个属性CacheSize，表示从服务器端临时表中读取记录缓存的大小，现假定CacheSize=5，那么ADO会一次从临时表中读取5条记录到ADO的缓存当中。只有当读取完缓存中第5条记录后再要读下一条记录时，ADO才去从临时表获取下5条记录。因此在这里有一点大家需要注意，正向临时表只能前向滚动，可使用Recordset的MoveNext在临时表中前向滚动，但使用MovePrevious、MoveFirst、MoveLast方法会出错，不过我们可以在Move方法中使用负数对缓存中的数据实现后向滚动，如Move -1表示向前滚动一条缓存中的记录，当然前提条件是滚动不超过缓存区域边界。
    正向临时表有一种特殊情况，也就是当CacheSize=1，这种临时表被称为“消防水带”临时表，数据出来速度极快，一些数据库只支持这类临时表。非常适合我们从数据库读出数据到工作表中。
    从正向临时表的原理来看，在读取数据过程中我们根本无法确定数据有多少，数据从头到尾一批批（条条）地读到缓存中，因此我们要获取记录数只能采取计数的方法或使用SQL的count函数来实现，因此如果去读取该类临时表的RecordCount属性的话会返回-1。
下面给出一个正向临时表的示例。


Sub ForwardOnlyCursor()
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sSqlCommand As String
    Set cn = New ADODB.Connection   '实例化Connection对象
    cn.CursorLocation = adUseServer '设置connection对象的临时表位置
    cn.ConnectionString = "Provider=SQLOLEDB;User ID=sa;Password=123;Initial Catalog=testDB;Data Source = localhost"    '连接字符串，本处为连接SQL Server的连接字符串
    cn.Open '建立连接
    
    Set rs = New ADODB.Recordset    '实例化Recordset对象
    rs.CursorLocation = adUseServer '前面已经设置了connection对象的临时表位置，如此处省略，则rs会继承cn的这个值，因此本句可以省略，这里只是为了说明而加上了这一句。
    rs.CursorType = adOpenForwardOnly   '设置rs为正向临时表
    rs.CacheSize = 5    '设置rs缓存大小为5
    sSqlCommand = "SELECT * FROM test"
    rs.Open sSqlCommand, cn  '打开rs
    
    '........
    '.代码.
    '........
    
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

2、静态临时表，CursorType=adOpenStatic，静态临时表与正向临时表类似，不同的地方在于表态临时表支持前滚和后滚，当查询结束后，查询结果会全部保存在临时表中，这时其他用户对数据库中数据的插入、修改、删除都不会影响到临时表中的数据，临时表中的信息是静态的，因此可以通过RecordCount属性获取到记录数，该记录数只表示查询时数据库中满足记录的个数。静态临时表的示意图如下。

    我们可以看到整个结构和正向临时表基本一致，唯一的区别在于记录只可以前后滚动。黄色区域表示ADO缓存中的数据。当ADO Recrodset中使用各种MOVE方法对记录进行浏览时，一旦超过了当前缓冲区中的数据，则ADO将从临时表中获取下一批的数据。静态临时表一般来说都是只读的，所有客户机端的临时表都是静态临时表，但客户机端的临时表与服务器端的临时表还是有一定的区别的，我们在后面再讲座这个问题。

    3、键集临时表，CursorType=adOpenKeyset。
    我们先来讲讲什么是键，键是数据库中一个非常重要的概念，一般来说在一张数据库的表中会有一个字段，这个字段内的值是不可以重复的，我们可以称这个字段为键，通过键我们可以唯一地确定一条记录，表中可以存在多个键，但只能确定一个键为主键（Primary Key）,当一张表中的主键存在于另一张表中，则该主键是另一张表的外键，通过主键和外键，我们可以把多张表很方便的连接起来。举个例子来说，假设一个学校建立一个学生信息库，那么会有一张表中记录有学生的姓名、性别、出生年月等等信息，当然最重要的是在这张表中应该还有一个学号，我们可以把学号看成是这张表的主键，因为一般来说学号是不重复的，我们就称这张表为基本情况表吧。第一学期结束了，学校把每个学生的考试成绩录入数据库，建立一张表，我们称为成绩表，这张表中当然还会有一个主键，这个主键可能是由计算机产生的一个序列数，反正是不能重复的。表中还会有如学号、科目、成绩等字段，因为一个学生会有几个考试成绩，因此在这张表中同一学号会多次出现，学号在成绩表中被称为外键，通过学号，我们可以很方便的把基本情况表和成绩表连接起来，这就是主键和外键的主要功能。
接下来我们就可以讲讲键集临时表了。我先把示意思贴上。

    当ADO提出查询后，临时表中只保存满足条件的记录的键值，当要填充Recrodset缓冲区时，才根据键值，从数据库中把数据读取出来填充到缓冲区。当浏览超过缓冲区边界后，又会要根据键值去读取数据库中的信息，因此键集临时表可以看到其他用户对数据库中数据的更改。那么当其他用户在数据库中插入了新的满足条件的记录呢？由于键集在查询结束后已经确定，之后不会重新将满足记录的键值读取到临时表中，因此其他用户的插入操作对于键集临时表来说是不可见的。正因为键集在查询结束后基本保持静态，因此可以通过RecrodCount属性获取记录数。另一个问题，如果在临时表存在的过程中，其他用户将键集中的一条记录删除了会怎样？这时当键集临时表填充缓冲区时发现一条记录找不到了，那么这个键值会被临时表从键集中删除。因为这个删除的过程是临时表操作的，因此还是可以通过RecrodCount属性获取记录数。
键集临时表对键集中的键值只减不增，因此该临时表对其他用户的插入不可见，修改和删除可见。键集临时表支持前向和后向的滚动。

    4、动态临时表，CursorType= adOpenDynamic。
    动态临时表与键集临时表非常相似，最大的区别在于每当填充ADO Recordset缓冲区都将重新查询生成键集，因此动态临时表对于其他用户的插入也可见。

    动态临时表对键集部的键值可增可减，因此动态临时表对其他用户的插入、修改、删除都可见，可以是说这么多临时中功能最强大的了，但缺点也很明显，因为每当填充缓冲区都将触发查询，因此对于数据库的压力会较大，速度也最慢。

    接下来我们来讲讲客户机端的临时表吧CursorLocation=AdUseClient。客户机端临时表都是静态临时表，与服务器端静态临时表不同之处在于，服务器端静态临时表是由OLE DB提供程序或数据库来管理的，客户机端临时表是由ADO临时表引擎来管理的。

    前面我们在服务器端静态临时表中提到，静态临时表一般都是只读的，客户机端临时表也是静态临时表，也是只读的，但我们却可以通过ADO对客户机端临时表的数据实现读与写。大家看到这里肯定觉得我逻辑混乱吧。没错，刚开始我也这么觉得。其实客户机端的临时表的确是只读的，那为什么又支持读写呢，那是因为ADO临时表引擎对读写提供了支持，当对临时表数据进行写操作时，其实并没有真正去写临时表，而是由ADO临时表引擎把相关的操作记录下来，并存入缓存中，当调用recordset的Update或UpdateBatch操作时，ADO临时表引擎把这些改动转换为操作查询来更新数据库，这就是客户机端静态临时表可更新的原因。
    客户机端临时表由于使用了ADO临时表引擎，因此有非常丰富的功能，如搜索、排序、过滤、批更新、暂存、自动建立索引等。而且客户机端临时表可以不需要数据库连接，当查询数据以消防水带的形式填充到静态临时表中后，我们可以断开Recordset的活动连接，继续对临时表中的数据进行其他的操作，当需要更新数据库时重新找开连接，完成更新。ADO临时表引擎提供的暂存功能也很有意思，可以先把活动连接断开，然后把临时表的信息保存成一个文件存放在硬盘中，当需要时重新打开这个文件，恢复连接，更新数据库。这是一个非常酷的功能。
当然客户机端临时表也有它不足的地方，因为可以脱机操作，这就导致在数据库会频繁更改的情况下不能及时更新数据。
总的来说客户机端临时表功能丰富，对数据库压力小，效率高（可参见我以前的一个贴子），因此除非一定要用服务器端临时表，强烈建议大家尽可能地使用这种临时表。ADO默认使用的是服务器端临时表，这是因为客户机端临时表出现得比服务器端临时表晚，为了向后兼容，所以把服务器端临时表作为默认值。
    每种临时表都有各自的特点，大家在使用过程中要保持够用原则，毕竟功能的增加会带来很多负面的影响，希望我对临时表的讲解对大家有所帮助。文中有的地方是我对自己的理解，可能会有错误，望大家发现错误能指正。谢谢。

FileSystemObject详解

FSO是FileSystemObject 或 Scripting.FileSystemObject 的缩写，为 IIS 内置组件，用于操作磁盘、文件夹或文本文件。FSO 的对象、方法和属性非常的多，这里用示例的方式列出常用的。

引用FSO对象的方法

'前期绑定：先要引用类库文件scrrun.dll，写代码的时候有智能提示。如果程序发给别人用，就要用后期绑定方式。

Dim fso As New Scripting.FileSystemObject 

'后期绑定：不需要引用类库文件，但没有智能提示。

Set fso = CreateObject("Scripting.FileSystemObject")

注意：《VBScript 语言参考》或《JScript 语言参考》中的：《FileSystemObject 用户指南》和《Scripting 运行时库参考》便是微软给出的 FileSystemObject 完整参考。

FSO 不能操作二进制文件，要操作二进制文件，使用：ADODB.Stream。

'创建文件
set fso = server.CreateObject("Scripting.FileSystemObject")
set f = fso.CreateTextFile("C:\test.txt", true) '第二个参数表示目标文件存在时是否覆盖
f.Write("写入内容")
f.WriteLine("写入内容并换行")
f.WriteBlankLines(3) '写入三个空白行（相当于在文本编辑器中按三次回车）
f.Close()
set f = nothing
set fso = nothing

'打开并读文件
set fso = server.CreateObject("Scripting.FileSystemObject")
set f = fso.OpenTextFile("C:\test.txt", 1, false) '第二个参数 1 表示只读打开，第三个参数表示目标文件不存在时是否创建
f.Skip(3) '将当前位置向后移三个字符
f.SkipLine() '将当前位置移动到下一行的第一个字符，注意：无参数
response.Write f.Read(3) '从当前位置向后读取三个字符，并将当前位置向后移三个字符
response.Write f.ReadLine() '从当前位置向后读取直到遇到换行符（不读取换行符），并将当前位置移动到下一行的第一个字符，注意：无参数
response.Write f.ReadAll() '从当前位置向后读取，直到文件结束，并将当前位置移动到文件的最后
if f.atEndOfLine then
   response.Write("一行的结尾！")
end if
if f.atEndOfStream then
    response.Write("文件的结尾！")
end if
f.Close()
set f = nothing
set fso = nothing

'打开并写文件
set fso = server.CreateObject("Scripting.FileSystemObject")
set f = fso.OpenTextFile("C:\test.txt", 2, false) '第二个参数 2 表示重写，如果是 8 表示追加
f.Write("写入内容")
f.WriteLine("写入内容并换行")
f.WriteBlankLines(3) '写入三个空白行（相当于在文本编辑器中按三次回车）
f.Close()
set f = nothing
set fso = nothing

'判断文件是否存在
set fso = server.CreateObject("Scripting.FileSystemObject")
if fso.FileExists("C:\test.txt") then
    response.Write("目标文件存在")
else
    response.Write("目标文件不存在")
end if
set fso = nothing

'移动文件
set fso = server.CreateObject("Scripting.FileSystemObject")
call fso.MoveFile("C:\test.txt", "D:\test111.txt") '两个参数的文件名部分可以不同
set fso = nothing

'复制文件
set fso = server.CreateObject("Scripting.FileSystemObject")
call fso.CopyFile("C:\test.txt", "D:\test111.txt") '两个参数的文件名部分可以不同
set fso = nothing

'删除文件
set fso = server.CreateObject("Scripting.FileSystemObject")
fso.DeleteFile("C:\test.txt")
set fso = nothing

'创建文件夹
set fso = server.CreateObject("Scripting.FileSystemObject")
fso.CreateFolder("C:\test") '目标文件夹的父文件夹必须存在
set fso = nothing

'判断文件夹是否存在
set fso = server.CreateObject("Scripting.FileSystemObject")
if fso.FolderExists("C:\Windows") then
    response.Write("目标文件夹存在")
else
    response.Write("目标文件夹不存在")
end if
set fso = nothing

'删除文件夹
set fso = server.CreateObject("Scripting.FileSystemObject")
fso.DeleteFolder("C:\test") '文件夹不必为空
set fso = nothing

'检测驱动器C盘是否存在
Set fso = Server.CreateObject("Scripting.FileSystemObject")
fso.DriveExists("c:")

'获取文件路径的驱动器名
Set fso=Server.CreateObject("Scripting.FileSystemObject")
p=fso.GetDriveName(Server.MapPath("aqa33"))
Response.Write("驱动器名称是：" & p)
set fs=nothing

'取得某个指定的路径的父文件夹的名称
Set fso=Server.CreateObject("Scripting.FileSystemObject")
p=fso.GetParentFolderName(Server.MapPath("aqa331.asp"))
Response.Write("父文件夹名称是：" & p)
set fs=nothing

'取得指定路径中的最后一个成分的文件扩展名
Set fs=Server.CreateObject("Scripting.FileSystemObject")
Response.Write(fs.GetExtensionName(Server.MapPath("aqa33.asxd")))
set fs=nothing

'取得指定路径中的最后一个成分的文件名
Set fs=Server.CreateObject("Scripting.FileSystemObject")
Response.Write(fs.GetFileName(Server.MapPath("aqa33.asxd")))
set fs=nothing

'返回在指定的路径中文件或者文件夹的基本名称。

Set fso=Server.CreateObject("Scripting.FileSystemObject")
Response.Write(fso.GetBaseName("c:\windows\cursors\abc.cur"))
Response.Write("<br />")
Response.Write(fso.GetBaseName("c:\windows\cursors\"))
Response.Write("<br />")
Response.Write(fso.GetBaseName("c:\windows\"))
set fso=nothing

初始化工作表——按照第一行单元格的值，给该单元格添加名称

导入和分析ref脚本Download
Sub Main_Creat_Names_For_Worksheet_RefFiles()
Call ThisWorkbook.Creat_Names_By_First_Row(RefFiles)
MsgBox "Done!"
End Sub


Sub Creat_Names_By_First_Row(Ws As Worksheet)
'按照第一行单元格的值，给该单元格添加名称
Dim N As Integer
'删除已有名称
If Ws.Names.Count > 0 Then
    For I = Ws.Names.Count To 1 Step -1
        Ws.Names(I).Delete
    Next I
End If
'开始添加名称
N = 0
With Ws.Cells(1, 1)
    Do While Len(Trim(.Offset(0, N))) > 0
        Ws.Names.Add Name:=Trim(.Offset(0, N)), RefersToR1C1:="=" & Ws.Name & "!R1C" & N + 1
        N = N + 1
    Loop
End With
End Sub

导入文本文件——批量导入.ref脚本文件，提取命令及参数等重要信息

导入和分析ref脚本Download
Sub Main_Import_Multiple_RefFile_Into_Worksheets_RefFiles() '可多选
Dim I&, J&, R&, C%, S$, T, Items, F
Dim Remark As String
Dim HaveExcuted As Boolean, FindParameter As Boolean
Dim myFso As Object, myTxt As Object
Dim strTmp As String
Dim Ws As Worksheet
Dim NRow As Integer, NCol As Integer
Dim NParameter As Integer
'1.选择要导入的文件
With Application.FileDialog(1)
    With .Filters
        .Clear
        .Add "REF脚本文件(ref)", "*.ref"
    End With
    .AllowMultiSelect = True
    If .Show Then Set Items = .SelectedItems Else Exit Sub
End With
'2.打开、分析选中的文件，只导入有用的信息
Application.ScreenUpdating = False
For Each F In Items '遍历选中的所有文件
    With RefFiles.Cells(1, 1)
        '获取工作表RefFiles的基本信息
        NRow = .CurrentRegion.Rows.Count
        NCol = .CurrentRegion.Columns.Count
        N = 0
        '开始分析文件
        HaveExcuted = False
        Set myFso = CreateObject("Scripting.FileSystemObject")
        Set myTxt = myFso.OpenTextFile(F, 1)
        R = 1
        Do Until myTxt.AtEndOfStream
            strTmp = Trim(myTxt.Readline)
            '处理EDIIMM脚本
            If Left(strTmp, 25) = "echo '<EDIIMM> TRAITEMENT" Then '找到EDIIMM脚本执行程序的第一行
                '填写工作表RefFiles的第 i 行
                N = N + 1
                I = NRow + N
                '填写FileName
                J = RefFiles.Names("FileName").RefersToRange.Column '填写工作表RefFiles的第 j 列
                RefFiles.Cells(I, J) = Mid(F, InStr(F, "\edi") + 1, 32)
                '填写ProgramOrder
                J = RefFiles.Names("ProgramOrder").RefersToRange.Column '填写工作表RefFiles的第 j 列
                RefFiles.Cells(I, J) = N
                '填写ProgramName
                J = RefFiles.Names("ProgramName").RefersToRange.Column '填写工作表RefFiles的第 j 列
                RefFiles.Cells(I, J) = Trim(Right(strTmp, Len(strTmp) - 25))
                '填写TimeImport
                J = RefFiles.Names("TimeImport").RefersToRange.Column '填写工作表RefFiles的第 j 列
                RefFiles.Cells(I, J) = Now
                '填写该命令的参数
                FindParameter = False
                NParameter = 0
                Do Until myTxt.AtEndOfStream
                    strTmp = Trim(myTxt.Readline)
                    If strTmp = "</EDIIMM>'" Then Exit Do
                    If FindParameter = True Then
                        NParameter = NParameter + 1
                        If NParameter > 70 Then
                            MsgBox Mid(F, InStr(F, "\edi") + 1, 32) & "——这个文件竟然有超过70个参数的程序，超过70的参数将不被记录！记得查查是否有问题！", vbExclamation
                            Exit Do
                        End If
                        If NParameter > 9 Then
                            J = RefFiles.Names("Parameter" & Trim(Str(NParameter))).RefersToRange.Column
                        Else
                            J = RefFiles.Names("Parameter" & "0" & Trim(Str(NParameter))).RefersToRange.Column
                        End If
                        RefFiles.Cells(I, J) = strTmp
                    End If
                    If strTmp = "</PARAM>" Then FindParameter = True
                Loop
            End If
            '处理EDIBAT脚本
            If strTmp = "mclient-line menu.general.unix << EOF" Then '找到EDIIMM脚本执行程序的第一行
                '填写工作表RefFiles的第 i 行
                N = N + 1
                I = NRow + N
                '填写FileName
                J = RefFiles.Names("FileName").RefersToRange.Column '填写工作表RefFiles的第 j 列
                RefFiles.Cells(I, J) = Mid(F, InStr(F, "\edi") + 1, 32)
                '填写ProgramOrder
                J = RefFiles.Names("ProgramOrder").RefersToRange.Column '填写工作表RefFiles的第 j 列
                RefFiles.Cells(I, J) = N
                '填写ProgramName
                Do Until myTxt.AtEndOfStream
                    strTmp = Trim(myTxt.Readline)
                    If InStr(strTmp, "TRAITEMENT") > 0 Then
                        J = RefFiles.Names("ProgramName").RefersToRange.Column '填写工作表RefFiles的第 j 列
                        RefFiles.Cells(I, J) = Trim(Left(Right(strTmp, Len(strTmp) - InStr(strTmp, "TRAITEMENT") - 10), _
                            InStr(Right(strTmp, Len(strTmp) - InStr(strTmp, "TRAITEMENT") - 10), " ") - 1))
                        Exit Do
                    End If
                Loop
                '填写TimeImport
                J = RefFiles.Names("TimeImport").RefersToRange.Column '填写工作表RefFiles的第 j 列
                RefFiles.Cells(I, J) = Now
                '填写该命令的参数
                NParameter = 0
                Do Until myTxt.AtEndOfStream
                    strTmp = Trim(myTxt.Readline)
                    If InStr(strTmp, "MAG") > 0 Then Exit Do
                    NParameter = NParameter + 1
                    If NParameter > 70 Then
                        MsgBox Mid(F, InStr(F, "\edi") + 1, 32) & "——这个文件竟然有超过70个参数的程序，超过70的参数将不被记录！记得查查是否有问题！", vbExclamation
                        Exit Do
                    End If
                    If NParameter > 9 Then
                        J = RefFiles.Names("Parameter" & Trim(Str(NParameter))).RefersToRange.Column
                    Else
                        J = RefFiles.Names("Parameter" & "0" & Trim(Str(NParameter))).RefersToRange.Column
                    End If
                    RefFiles.Cells(I, J) = strTmp
                Loop
            End If
        Loop
        myTxt.Close
        Set myTxt = Nothing
        Set myFso = Nothing
    End With
Next F
RefFiles.Activate
RefFiles.Columns.AutoFit
RefFiles.Cells(1, 1).Select
Application.ScreenUpdating = True
MsgBox "DONE!", vbInformation
End Sub

导入文本文件——批量导入日志文件，按照关键词给每行文本添加标记

导入和分析ref脚本的log日志文件Download
Sub Main_Import_Multiple_TextFile_Into_Multiple_Worksheets() '可多选
Dim I&, R&, C%, S$, T, Items, F, N
Dim Remark As String
Dim HaveExcuted As Boolean
Dim FilePath 'ITEMS.PARENT.InitialFileName
Dim myFso As Object
Dim myTxt As Object
Dim strTmp As String
Dim Ws As Worksheet
'1.选择要导入的文件
With Application.FileDialog(1)
    With .Filters
        .Clear
        .Add "COM日志文件(com)", "*.com"
        .Add "LOG日志文件(log)", "*.log"
        .Add "REF脚本文件(ref)", "*.ref"
        .Add "所有文件", "*.*"
    End With
    .AllowMultiSelect = True
    If .Show Then Set Items = .SelectedItems Else Exit Sub
End With
'2.导入选中的文件
Application.ScreenUpdating = False
For Each F In Items
    Worksheets.Add after:=ActiveSheet
    With ActiveSheet
        N = N + 1
        .Name = "Log_" & N
        .Columns("A:A").ColumnWidth = 100
        .Columns("B:B").ColumnWidth = 30
        HaveExcuted = False
        .Cells(1, 1) = "文件名：" & F '文件名放在第1列
        .Cells(1, 2) = "标签" '标签放在第2个列
        Set myFso = CreateObject("Scripting.FileSystemObject")
        Set myTxt = myFso.OpenTextFile(F, 1)
        R = 1
        Do Until myTxt.AtEndOfStream
            strTmp = Trim(myTxt.Readline)
            If Len(strTmp) > 0 Then
                R = R + 1
                .Cells(R, 1) = strTmp
                If strTmp = "EXECUTION" Then HaveExcuted = True
                Remark = Get_Tag_of_RefLogFile(.Cells(R, 1), HaveExcuted)
                'If Remark <> "" Then
                '    .Cells(R, 1).AddComment
                '    .Cells(R, 1).Comment.Visible = False
                '    .Cells(R, 1).Comment.Text Text:=Remark
                'End If
            End If
        Loop
        myTxt.Close
        Set myTxt = Nothing
        Set myFso = Nothing
    End With
Next F
'修改所有工作表的名称
'For Each Ws In ThisWorkbook.Worksheets
'    If Left(Ws.Cells(1, 1), 4) = "文件名：" Then
'        Ws.Name = Mid(F, InStr(F, "\edi") + 1, 32)
'    End If
'Next Ws
Application.ScreenUpdating = True
MsgBox "DONE!", vbInformation
End Sub


Function Get_Tag_of_RefLogFile(MsgCell As Range, HaveExcuted As Boolean) As String
'只能分析log文件，例如 edibat_valivl_fi1221_0407_135458_wwef.com_30734_20200407_135458.log
Dim MSG As String
MSG = MsgCell
If Left(MSG, 5) = "\n---" Then
    Get_Tag_of_RefLogFile = ""
    MsgCell.Offset(0, 1) = "Normal"
    'MSGCELL.Font.ThemeColor = xlThemeColorDark1
ElseIf MSG = "LOADED MENU.GENERAL.UNIX" Then
    Get_Tag_of_RefLogFile = ""
    MsgCell.Offset(0, 1) = "Normal"
ElseIf MSG = "EXECUTION" Then
    Get_Tag_of_RefLogFile = ""
    MsgCell.Offset(0, 1) = "Normal"
    'Get_Tag_of_RefLogFile = "开始执行"
ElseIf Left(MSG, 15) = "Enter value for" Then
    Get_Tag_of_RefLogFile = "输入指定值"
    MsgCell.Offset(0, 1) = "Begin to Input"
    MsgCell.Font.Color = vbBlue
ElseIf Mid(MSG, 3, 1) <> ":" Then '开头不是时间
    If Len(MSG) > 10 Then
        If HaveExcuted = True Then
            Get_Tag_of_RefLogFile = "可能是报错信息"
            MsgCell.Font.Color = vbRed
            MsgCell.Offset(0, 1) = "Maybe Error"
        Else
            Get_Tag_of_RefLogFile = ""
            MsgCell.Offset(0, 1) = "Normal"
        End If
    End If
Else
    MsgCell.Offset(0, 1) = "Normal Maybe"
End If
End Function