推荐觉得论坛回帖过程中下载附件，解压缩，编辑后再压缩繁琐的朋友进来看看

shaowu459

【关于winrar压缩文件的代码参见：http://club.excelhome.net/forum.php?mod=viewthread&tid=874971&page=1#pid5988428，注意按照3楼的说明修改一下参数即可】

目前论坛回帖的excel表格附件只能是压缩附件，对于经常在论坛帮助大家答疑解惑的人来说频繁的下载，解压缩，再压缩很麻烦，且自己存档后也不方便查找，除非手动自己重命名文件。

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

这两天通过求助AVEL和自己的摸索，我完善了一个保存压缩文件的宏，调用本地的压缩软件（http://club.excelhome.net/thread-865133-1-1.html）直接压缩文件并存档。在论坛上直接选择打开压缩文件，编辑公式后点击按钮运行该宏，则该文件被压缩放在桌面上方便直接回帖上传，而相应的工作簿也会按照时间命名保存在自己需要的位置留作存档，方便以后检索使用。同时，工作簿名称也标准化了。

代码之所以有两部分是因为第一次存储后我可能又想到更好的方法或者去完善原来做的公式或者代码，然后再次压缩时工作簿已经是标准名称了，加上了名称和时间的前缀（比如我设置的EH（超人）），这样就不用再在文件名前加前缀了，只更新时间即可。

详细操作过程参见操作动画。后附代码（可以参考自己电脑的压缩文件位置和想要的文件前缀修改，代码中的注解我没有更新）。代码可以存在压缩文件或者加载宏中，然后工具栏指定一个按钮。

1. Sub Winrar()
   
2.     Application.DisplayAlerts = False
   
3.     Dim TheRarexe As String    'WINRAR程序的位置
   
4.     Dim TheSource As String    '压缩前的源文件
   
5.     Dim TheTarget As String    '压缩好的文件
   
6.     Dim TheFileString As String
   
7.     Dim TheResult As Long
   
8. 
   
9.     If InStr(ActiveWorkbook.Name, "EH(超人)") > 0 Then
   
10. 
    
11.         With ActiveWorkbook
    
12.             TheRarexe = "C:\Program Files\WinZip\WINZIP32"    '系统WINRAR路径
    
13.             '.SaveCopyAs "C:\Users\clarkshao\Desktop\EH(超人)-" & Format(Date, "yyyy.mm.dd") & "-" & .Name   '另存为D盘根目录下，作为压缩用的临时文件
    
14.             .SaveCopyAs "C:\Users\clarkshao\Desktop\EH(超人)-" & Format(Date, "yyyy.mm.dd") & Mid(.Name, 18, InStrRev(.Name, ".xl") - 1)    '另存为D盘根目录下，作为压缩用的临时文件
    
15.             TheSource = "C:\Users\clarkshao\Desktop\EH(超人)-" & Format(Date, "yyyy.mm.dd") & Mid(.Name, 18, InStrRev(.Name, ".xl") - 1)  '临时文件作为压缩源文件
    
16.             TheTarget = "C:\Users\clarkshao\Desktop\EH(超人)-" & Format(Date, "yyyy.mm.dd") & Mid(.Name, 18, InStrRev(.Name, ".xl") - 18) & ".zip"       '保存到目录
    
17.             TheFileString = TheRarexe & " -min -a " & TheTarget & " " & TheSource
    
18.             TheResult = Shell(TheFileString, vbHide)    '压缩
    
19.             Application.Wait Now + TimeValue("00:00:02")
    
20.             Kill TheSource    '删除临时文件
    
21.             .SaveAs "C:\Users\clarkshao\Desktop\EH(超人)帖子附件\EH(超人)-" & Format(Date, "yyyy.mm.dd") & Mid(.Name, 18, 99)     '另存为D盘根目录下，作为压缩用的临时文件
    
22.         End With
    
23. 
    
24.     Else
    
25. 
    
26.         With ActiveWorkbook
    
27.             TheRarexe = "C:\Program Files\WinZip\WINZIP32"    '系统WINRAR路径
    
28.             .SaveCopyAs "C:\Users\clarkshao\Desktop\EH(超人)-" & Format(Date, "yyyy.mm.dd") & "-" & .Name   '另存为D盘根目录下，作为压缩用的临时文件
    
29.             TheSource = "C:\Users\clarkshao\Desktop\EH(超人)-" & Format(Date, "yyyy.mm.dd") & "-" & .Name  '临时文件作为压缩源文件
    
30.             TheTarget = "C:\Users\clarkshao\Desktop\EH(超人)-" & Format(Date, "yyyy.mm.dd") & "-" & Mid(.Name, 1, InStrRev(.Name, ".xl") - 1) & ".zip"       '保存到目录
    
31.             TheFileString = TheRarexe & " -min -a " & TheTarget & " " & TheSource
    
32.             TheResult = Shell(TheFileString, vbHide)    '压缩
    
33.             Application.Wait Now + TimeValue("00:00:02")
    
34.             Kill TheSource    '删除临时文件
    
35.             .SaveAs "C:\Users\clarkshao\Desktop\EH(超人)帖子附件\EH(超人)-" & Format(Date, "yyyy.mm.dd") & "-" & .Name     '另存为D盘根目录下，作为压缩用的临时文件
    
36.         End With
    
37. 
    
38. 
    
39.     End If
    
40. 
    
41. 
    
42.     Application.DisplayAlerts = True
    
43. End Sub

复制代码

积分马上到达5位数字了，截图留念。

lpzxhjp

感谢shaowu459 老师！太需要了！
力顶......

AVEL

回帖的附件都各式各样的。
如果可以用超人的办法规范一下，那是最好不过了。
推荐大家都试试。

醉意流年

此贴必火，，收藏了，学习下代码的写法和思路。
慢慢就可以规范化了。

shaowu459

晒晒这两天用这个方法存档的文件（简单函数应用的就没存了，要不然文件太多），这些都是留着以后能直接使用，或以后直接回帖用的。稍微差一点的就是求助的楼主没有对工作簿做一个有代表性的名称。

doitbest

好一个有心人，我代表自己表示高度认同！！

她的插曲

原来这样都可以的啊{:soso_e113:}

熊小华

{:soso_e179:}原来我还在农耕时代啊

申仙林

赶紧去试试！
谢谢分享了。
期待持续有这种好东西分享哦！

shaowu459

华小熊同学已经做好了wirar代码的，有个帖子在vba区。改下存储路径就行了