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

幻砾

真是好东西 谢谢

lpzxhjp

shaowu459 老师：您好
请您看看为啥我按您的代码改的加载宏不能在指定文件夹里压缩文件，而是在D盘我的文档文件夹里生成一个名为“My Documents”的空压缩文件。并提示最后一句代码错误“ .SaveAs "C:\Documents and Settings\Administrator\桌面\lpzxhjp的问题帖子附件\lpzxhjp-" & Format(Date, "yyyy.mm.dd") & "-" & .Name”

shaowu459

lpzxhjp 发表于 2012-6-10 21:39
shaowu459 老师：您好
请您看看为啥我按您的代码改的加载宏不能在指定文件夹里压缩文件，而是在D盘我的文档 ...

你打开一个工作簿，然后在代码那里一下一下的按F8，并且随时查看代码的效果，比如说另存了文件，比如说启动了压缩程序，看看到底是哪里出错。出错的时候debug，用鼠标从黄色的部分一点点划过，看看有什么异常的返回值。

lpzxhjp

谢谢老师：麻烦您看看，我用的是好压软件。我调试不来了！

lpzxhjp

shaowu459 发表于 2012-6-10 22:09
你打开一个工作簿，然后在代码那里一下一下的按F8，并且随时查看代码的效果，比如说另存了文件，比如说启 ...

谢谢您，我再看看！

lpzxhjp

shaowu459 发表于 2012-6-10 22:09
你打开一个工作簿，然后在代码那里一下一下的按F8，并且随时查看代码的效果，比如说另存了文件，比如说启 ...

shaowu老师：把他用在好压中我还是搞不定，只能麻烦您了，谢谢！

lpzxhjp

shaowu459 发表于 2012-6-10 22:09
你打开一个工作簿，然后在代码那里一下一下的按F8，并且随时查看代码的效果，比如说另存了文件，比如说启 ...

老师：您好，我安装了winrar，用大熊的代码，改成我的路径，还是提示无法找到路径，无法压缩！

lpzxhjp

shaowu459 发表于 2012-6-10 22:09
你打开一个工作簿，然后在代码那里一下一下的按F8，并且随时查看代码的效果，比如说另存了文件，比如说启 ...

麻烦老师看看，谢谢！我的代码：

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

复制代码

shaowu459

lpzxhjp 发表于 2012-6-12 10:36
麻烦老师看看，谢谢！我的代码：

你打开的工作簿得是保存过的工作簿，不能新建一个就这样操作。因为在网上打开的文件其实也是存在本地的临时文件夹里的。

lpzxhjp

shaowu459 发表于 2012-6-12 10:46
你打开的工作簿得是保存过的工作簿，不能新建一个就这样操作。因为在网上打开的文件其实也是存在本地的临 ...

老师：您好，我打开的就是坛子里的附件