如何将工作簿另存为2003版的同时压缩

shaowu459 · 发表于 2012-5-8 12:31

本帖最后由 shaowu459 于 2012-5-9 15:08 编辑

问题起源于目前论坛回帖的excel表格附件只能是压缩附件。我知道下载了压缩包后直接双击压缩包然后在直接打开的文件里操作，最后点击保存即可将改动记录在压缩包里。

但是目前个人的习惯是这样的：在帖子中直接点击比如说一楼的压缩文件，不选择下载，选择直接打开，然后简单问题可能先写公式然后另存到桌面上，复杂问题就先另存excel表到桌面上，然后再编辑，等做好了再压缩，然后回帖上传。另外，我也喜欢将工作簿存档留待以后学习参考，而不是压缩文件。

请教，是否可以帮我写一个宏，然后我加载到工具栏上，这样每次我在网页上直接打开的工作簿或者本地的桌面工作簿编辑完毕后，只需点击该按钮即可将相应的压缩文件保存在桌面上。这样就可以省去一些工作量，否则按照我现在的习惯，打开--》另存--》编辑代码或公式--》压缩--》回帖上传，每天会操作很多次，比较麻烦。

请教各位是否可以编写这样的代码来简化这些操作？谢谢。目前我装的压缩软件是winzip，如果需要软件路径的话回头我可以上传，或者代码里我可以自己修改。

谢谢。如果我解释的不清楚，麻烦跟帖询问，再次感谢。

该贴已经同步到 shaowu459的微博

cxh2010 · 发表于 2012-5-8 12:52

好想法，我不行，帮你顶一下

lpzxhjp · 发表于 2012-5-8 13:04

shaowu459 老师的认真负责的态度很让人折服，我也早有这种想法，一直没提出来。顶一下！！！

shaowu459 · 发表于 2012-5-8 18:07

下班前自己顶贴，因为感觉这个功能就混EH来说很方便。

AVEL · 发表于 2012-5-9 00:11

本帖最后由 AVEL 于 2012-5-9 00:34 编辑

Option Explicit
Sub Winrar()
Dim TheRarexe As String 'WINRAR程序的位置
Dim TheSource As String '压缩前的源文件
Dim TheTarget As String '压缩好的文件
Dim TheFileString As String
Dim TheResult As Long
With ActiveWorkbook
      TheRarexe = "C:\program files\winrar\winrar" '系统WINRAR路径
      .SaveCopyAs "D:\" & .Name '另存为D盘根目录下，作为压缩用的临时文件
      TheSource = "D:\" & .Name '临时文件作为压缩源文件
      TheTarget = "D:\" & "EH(超人)-" & Mid(.Name, 1, InStrRev(.Name, ".") - 1) & ".rar" '保存到D盘根目录,以超人带头命名如何？：）
      TheFileString = TheRarexe & " a " & TheTarget & " " & TheSource
      TheResult = Shell(TheFileString, vbHide) '压缩
      Kill TheSource '删除临时文件
End With
End Sub

搜索论坛里面的求助文件修改了一下
原帖如下：
请问压缩文件夹的代码怎么写？
http://club.excelhome.net/thread-507426-1-1.html

shaowu459 · 发表于 2012-5-9 08:17

AVEL 发表于 2012-5-9 00:11
Option Explicit
Sub Winrar()
Dim TheRarexe As String 'WINRAR程序的位置

呵呵，谢谢了。甚合我意，尤其是文件命中“超人”二字总得极为精妙，堪称绝世好文也:）。一会到了公司试试，压缩软件ZIP。

shaowu459 · 发表于 2012-5-9 14:36

Sub Winrar()
Dim TheRarexe As String 'WINRAR程序的位置
Dim TheSource As String '压缩前的源文件
Dim TheTarget As String '压缩好的文件
Dim TheFileString As String
Dim TheResult As Long
With ActiveWorkbook
TheRarexe = "C:\Program Files\WinZip\WINZIP32" '系统WINRAR路径
.SaveCopyAs "C:\Users\clarkshao\Desktop\1" & .Name '另存为D盘根目录下，作为压缩用的临时文件
TheSource = "C:\Users\clarkshao\Desktop\1" & .Name '临时文件作为压缩源文件
TheTarget = "C:\Users\clarkshao\Desktop\EH(超人)-" & Mid(.Name, 1, InStrRev(.Name, ".") - 1) & ".zip" '保存到目录
TheFileString = TheRarexe & " -min -a " & TheTarget & " " & TheSource
MsgBox TheFileString
TheResult = Shell(TheFileString, vbHide) '压缩
Kill TheSource '删除临时文件
End With
End Sub

复制代码

我晕菜了，这个代码时而行时而不行。。。对同一文件运行多次，有的时候行有的时候不行。有的时候逐句按F8运行是可以的，点击绿色按钮执行就不成。
各位能帮再看看么？是不是结束的时候要用什么语句关闭winzip的进程？

shaowu459 · 发表于 2012-5-9 14:39

我猜到可能是什么原因了。在
18. TheResult = Shell(TheFileString, vbHide) '压缩
19.
20. Kill TheSource '删除临时文件
之间的19行随便加点代码，比如说msgbox 111即可实现功能。是不是winzip压缩的过程中就执行了 the source这句代码造成的，也就是说代码执行的快，已经删除了文件，但是winzip还没有执行完毕？

shaowu459 · 发表于 2012-5-9 15:07

本帖最后由 shaowu459 于 2012-5-9 17:13 编辑

Sub Winrar()
Application.DisplayAlerts = False
Dim TheRarexe As String 'WINRAR程序的位置
Dim TheSource As String '压缩前的源文件
Dim TheTarget As String '压缩好的文件
Dim TheFileString As String
Dim TheResult As Long
With ActiveWorkbook
TheRarexe = "C:\Program Files\WinZip\WINZIP32" '系统WINRAR路径
.SaveCopyAs "C:\Users\clarkshao\Desktop\EH(超人)-" & Format(Date, "yyyy.mm.dd") & "-" & .Name '另存为D盘根目录下，作为压缩用的临时文件
TheSource = "C:\Users\clarkshao\Desktop\EH(超人)-" & Format(Date, "yyyy.mm.dd") & "-" & .Name '临时文件作为压缩源文件
TheTarget = "C:\Users\clarkshao\Desktop\EH(超人)-" & Format(Date, "yyyy.mm.dd") & "-" & Mid(.Name, 1, InStrRev(.Name, ".xl") - 1) & ".zip" '保存到目录
TheFileString = TheRarexe & " -min -a " & TheTarget & " " & TheSource
TheResult = Shell(TheFileString, vbHide) '压缩
Application.Wait Now + TimeValue("00:00:02")
Kill TheSource '删除临时文件
.SaveAs "C:\Users\clarkshao\Desktop\EH(超人)帖子附件\EH(超人)-" & Format(Date, "yyyy.mm.dd") & "-" & .Name '另存为D盘根目录下，作为压缩用的临时文件
End With
Application.DisplayAlerts = True
End Sub

复制代码

终于搞定了！！

shaowu459 · 发表于 2012-5-9 17:14

9楼代码更新了，加入了存储日期，方便以后查询

		自动登录	找回密码
密码			免费注册

[分享] 如何将工作簿另存为2003版的同时压缩

点评