[VBA ] 执行阶段错误'50290'

楼主: moon52016 (matrix)   2016-01-02 00:43:23
各位好
最近第一次使用VBA(之前也没碰过VB),碰上了一些问题:
目的是批量帮excel档案加密,利用sendkeys的做法((就像机器人一样...
(程式码是从网络上修改)
Sub Lock_file()
Dim xlapp As Excel.Application
Dim wbSource As Excel.Workbook
Dim LogFileName As Variant
Dim fname As Variant
Dim x As String, y As String
'取得密码
x = InputBox("请输入保护密码:", "保护密码")
y = InputBox("请输入写保护密码:", "写保护密码")
Set xlapp = New Excel.Application
'MultiSelect:=True 表示可复选档案
LogFileName = Application.GetOpenFilename( _
FileFilter:="Excel档(*.xlsx),*.txt", _
Title:="请选取档案", MultiSelect:=True)
'判断使用者是否有选取档案,或按取消
If VarType(LogFileName) = vbBoolean Then
Exit Sub
End If
xlapp.Visible = True
For Each fname In LogFileName
Set wbSource = xlapp.Workbooks.Open(CStr(fname))
DoEvents
With xlapp
.SendKeys "{F12}", True
Application.Wait (Now + TimeValue("0:00:02"))
.SendKeys "%L", True
Application.Wait (Now + TimeValue("0:00:01"))
.SendKeys "{DOWN}"
Application.Wait (Now + TimeValue("0:00:01"))
.SendKeys "g", True
Application.Wait (Now + TimeValue("0:00:01"))
.SendKeys x, True
Application.Wait (Now + TimeValue("0:00:01"))
.SendKeys "{TAB}", True
Application.Wait (Now + TimeValue("0:00:01"))
.SendKeys y, True
Application.Wait (Now + TimeValue("0:00:01"))
.SendKeys "{ENTER}", True
Application.Wait (Now + TimeValue("0:00:01"))
.SendKeys x, True
Application.Wait (Now + TimeValue("0:00:01"))
.SendKeys "{ENTER}", True
Application.Wait (Now + TimeValue("0:00:01"))
.SendKeys y, True
Application.Wait (Now + TimeValue("0:00:01"))
.SendKeys "{ENTER}", True
Application.Wait (Now + TimeValue("0:00:01"))
.SendKeys "{ENTER}", True
Application.Wait (Now + TimeValue("0:00:01")) '
End With
Next fname
Set wbSource = Nothing 'xlapp.Quit
End Sub
在执行第一个"按F12"之后就会出错
也测试过了除了第一条按F12以外,其他的都不会有效果
看键盘是"numberlock"亮暗亮暗QQ
已经有在网络上搜寻过,有人是说excel还没准备好,但是还是不知道该怎么解决
原来的程式码来源:
http://forum.twbts.com/viewthread.php?tid=2723

Links booklink

Contact Us: admin [ a t ] ucptt.com