|
执行问题求助
下载楼主的代码并封装成功,一切正常。
在加入了一段“设定默认启动表和用U盘做密钥盘”的代码后,如果U盘正确的话也没有问题。但是U盘不正确时就出问题了,出现“运行时错误‘75’《路径/文件访问错误》的提示。调试程序时直接指向“Open exec For Binary As #1 '打开EXE文件”这一句代码。我分析原因是:U盘不正确退出后程序仍要继续执行“Private Sub Workbook_BeforeClose(Cancel As Boolean)”宏所至,但就是不会修改,请楼主和各位老师帮忙给指点并改一下,谢谢!!
代码如下:
Private Const EXE_SIZE = 45056 '此处数字为前面第7步得到的EXE文件字节数
Private Type FileSection
Bytes() As Byte
End Type
————————————————————————————————————
Private Sub Workbook_Open()
Sheets("目录").Activate '设定默认启动工作表,启动文件时默认启动工作表将处于活动状态.
Dim objWMIService As Object '用U盘的物理序列号设定U盘为密钥盘.
Dim colItems As Object
Dim objitem As Object
Dim a, b, c, d, e, U_Dist
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_USBHub")
For Each objitem In colItems
a = objitem.DeviceID
If a Like "*VID*" Then
b = Split(a, "\")
c = Split(b(UBound(b) - 1), "&")
d = Split(c(UBound(c) - 1), "_")
e = Split(c(UBound(c)), "_")
U_Dist = d(UBound(d)) + e(UBound(e)) + b(UBound(b))
If U_Dist = "17EF1111111111111111111111" Then Exit Sub 'U盘物理序列号
End If
Next
MsgBox "找不到正确U盘,系统将退出!"
Application.Quit
ThisWorkbook.Close False
End Sub
——————————————————————————————————
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Close True
Dim myfile As FileSection '定义变量
Dim comc, exec, xlsc As String '定义变量
Application.Visible = False '隐藏EXCEL主窗口
exec = Worksheets("temp").Cells(1, 1).Value
xlsc = Worksheets("temp").Cells(2, 1).Value
comc = exec & " " & xlsc
Open exec For Binary As #1 '打开EXE文件
ReDim myfile.Bytes(1 To EXE_SIZE)
Get #1, 1, myfile.Bytes '取得固有文件头
Close #1
If VBA.Dir(exec) <> "" Then Kill exec
Open exec For Binary As #1 '生成新的EXE文件
Put #1, 1, myfile.Bytes '先写入文件头
Open xlsc For Binary As #2 '打开xls临时文件
ReDim myfile.Bytes(1 To FileLen(xlsc))
Get #2, 1, myfile.Bytes
Put #1, EXE_SIZE + 1, myfile.Bytes '将xls部分追加进EXE
Close #1
Close #2
Application.Quit
Shell comc, vbMinimizedNoFocus '删除临时xls文件
ThisWorkbook.Close False
End Sub
[ 本帖最后由 hanzhang98 于 2009-2-14 22:01 编辑 ] |
|