[分享]彻底解决EXCEL文件封装成EXE后无法保存的问题

jackal0546

谢谢，受教了，

wangzhihua_1226

好好学习
一定

zhengliqiang

再支持一下~！~！~

l296233

我用 ldhyob 的方法，是可以作出.exe文件，但与.xls文件合并后，运行生成的文件，只见启动窗一闪……就什么都没了，进不了EXCEL的文件！
用你上传的TEST.exe和OK.xls合并后，还真行！
现对楼主有一要求
能不能将你提供的例子的VB工程相关文件传上来，供大家学习！
谢谢！

hanzhang98

佩服楼主的研究精神!敬礼

zhenghua9256

佩服楼主的研究精神!敬礼

l296233

终于可以了，把工程文件和EXCEL文件同发上来，有兴趣的试试去，不错，可以保存！哈哈！！！

hanzhang98

下载楼主的代码并封装成功，一切正常。
      在加入了一段“设定默认启动表和用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 编辑 ]

dzpasserby

谢谢楼主分享，祝您健康快乐！

bigsunmoon

边看边学习