用VBS 调用application.open 出现 “服务器发生意外情况”

f22cdefeh

因研究并发需要，复制多份带宏的EXCEL文件
尝试用 VBS 调用 application.workbooks.open 来打开每个excel文件中的宏。
最后用WScript.Shell来 run 脚本 的时候，脚本先是提示“服务器发生意外情况”，过段时间后再提示“现在可以编辑XX文件”这个错误的发生是随机的，例如run30个脚本，会随机出N<30个意外。
感觉像是 Excel.Workbooks对象处理不过来open方法。
请问何解。
代码如下：

1. '生成一个n长度随机字符串
   
2. Private Function CreateRandomStr(n As Variant)
   
3.     sn = ""
   
4.     For i = 1 To n
   
5.         Randomize
   
6.         sn = sn + Chr(IIf(10 * Rnd > 5, Int(26 * Rnd + 65), Int(26 * Rnd + 97)))
   
7.         CreateRandomStr = sn
   
8.     Next i
   
9. End Function
   
10. '在桌面生成指定名称的目录
    
11. Private Function GetFolderName(strTargetName)
    
12.     foldername = strTargetName
    
13.     foldername = foldername & Format(Date, "yyyymmdd") & Format(Time, "hhmmss")
    
14.     foldername = Environ("userprofile") & "\Desktop" & foldername & ""
    
15.     If Dir(foldername, vbDirectory) = "" Then  '如果文件不存在
    
16.         MkDir foldername
    
17.     End If
    
18.     GetFolderName = foldername
    
19. End Function
    
20. Sub test(name)
    
21.     MsgBox name
    
22. End Sub
    
23. Sub 多线程测试()
    
24.     Dim testdir
    
25.     Dim filename
    
26.     Dim strvbs
    
27.     Dim strvbsfilename
    
28.     Dim cs
    
29.    
    
30.     cs = 30
    
31.     Set filename = CreateObject("Scripting.Dictionary")
    
32.     Set strvbsfilename = CreateObject("Scripting.Dictionary")
    
33.     testdir = GetFolderName("\多线程测试")
    
34. 
    
35.     For i = 1 To cs
    
36.         filename(i) = CreateRandomStr(10) & ".xlsm"
    
37.         ThisWorkbook.SaveCopyAs (testdir & filename(i))
    
38.         Do
    
39.         Loop While Dir(testdir & filename(i)) = Empty
    
40.     Next i
    
41.     For i = 1 To cs
    
42.         strvbsfilename(i) = testdir & CreateRandomStr(5) & ".vbs"
    
43.     Next i
    
44.         
    
45.     For i = 1 To cs
    
46.         strvbs = "Set objExcel = CreateObject(""Excel.Application"")" & vbCrLf
    
47.         strvbs = strvbs & "Set objWorkbook = objExcel.Workbooks.Open(""" & testdir & filename(i) & """)" & vbCrLf
    
48.         strvbs = strvbs & "objExcel.Application.Visible = false" & vbCrLf
    
49.         strvbs = strvbs & "objExcel.Application.Run" & """" & filename(i) & "!test""," & """" & filename(i) & """" & vbCrLf
    
50.         strvbs = strvbs & "objExcel.ActiveWorkbook.Close" & vbCrLf
    
51.         strvbs = strvbs & "objExcel.Application.Quit" & vbCrLf
    
52.         strvbs = strvbs & "Set objWorkbook = Nothing" & vbCrLf
    
53.         strvbs = strvbs & "Set objExcel = Nothing" & vbCrLf
    
54.         
    
55.         Open strvbsfilename(i) For Output As #1
    
56.         Print #1, strvbs
    
57.         Close #1
    
58.         
    
59.         
    
60.     Next i
    
61.     For i = 1 To cs
    
62.      Set wsh = VBA.CreateObject("WScript.Shell")
    
63.             wsh.Run strvbsfilename(i)
    
64.      Set wsh = Nothing
    
65.     Next i
    
66. End Sub
    

复制代码

多线程测试.rar (17.83 KB, 下载次数: 0)

2018-7-19 10:09 上传

点击文件名下载附件

f22cdefeh

经过排错，VBA本身没有问题，问题出在VBS中。
同时执行一批vbs脚本时 objExcel.Workbooks.Open 会出错，
大家有没有什么好办法。

f22cdefeh

见了鬼了。
因为Set objWorkbook = objExcel.Workbooks.Open 出问题，
导致后面 workbook.close 对象无法关闭。
再导致 打开的excel对象无法正常关闭。
最见鬼的是  objExcel.Application.Run却可以起作用。。。