文件解压

jsgj2023

要删除Office,干嘛不把系统也删了呢?哈哈

fxl447098457

建议你用winrar或者7z.这两个一个有免费版，一个就是开源的。360zip的官方条款里就已经说明了软件部分代码来自winrar，部分来自7z.你还不如直接用后面两个。节省点时间。

wcymiss

试试Shell：Sub Test()
    Dim objShell As Object
    Dim objFolder As Object
    Dim objFile As Object

    Set objShell = CreateObject("shell.application")
    Set objFolder = objShell.Namespace("F:\") '如果括号内容用变量的话一定要是Variant类型
    Set objFile = objFolder.ParseName("1.rar")

    objFile.InvokeVerb "解压到当前文件夹(&X)" '。不同语言版本的命令文字不同，具体参考文件夹或文件的右键菜单

    Set objFile = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
End Sub

smhf_6

jsgj2023 发表于 2017-12-14 14:14
要删除Office,干嘛不把系统也删了呢?哈哈

office 有山寨的 wps
window  山寨版有嘛？若有，总行一声令下，使用国产！ 下级谁敢不服从？

smhf_6

fxl447098457 发表于 2017-12-14 14:17
建议你用winrar或者7z.这两个一个有免费版，一个就是开源的。360zip的官方条款里就已经说明了软件部分代码 ...

谢谢您的建议，我们的爷爷在北京，他说什么就是什么，我们除了服从，没有其他选项

smhf_6

wcymiss 发表于 2017-12-14 16:03
试试Shell：Sub Test()
    Dim objShell As Object
    Dim objFolder As Object

非常感谢，明天上班试试

northwolves

测试通过

1. Private Declare Function SetWindowPos Lib "user32" (ByVal HWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
   
2. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
   
3. Sub UnRarFile()   '解压缩程序
   
4. Dim P&
   
5. P = Shell("E:\program files\360\360zip\360zip.exe " & " D:\TEST\TEST.ZIP ", vbNormalFocus)
   
6. SetWindowPos P, -1, 0, 0, 0, 0, 2
   
7. Sleep 1500
   
8. SendKeys "%E", True
   
9. SendKeys "{Enter}"
   
10. End Sub
    

复制代码

smhf_6

northwolves 发表于 2017-12-14 21:33
测试通过

非常感谢northwolves老师，可以实现。
不过有2个细小的问题，其实也不是大问题：解压后，桌面上，解压后产生的文件夹、360应用程序是打开的。
而程序菜单中且好有这两个选项，我处理后，文件夹是关闭了，但对应用程序似乎无效，大概这与程序操作有关吧，这个只是随便提提，关系不大，也是可以解决的

smhf_6

wcymiss 发表于 2017-12-14 16:03
试试Shell：Sub Test()
    Dim objShell As Object
    Dim objFolder As Object

谢谢wcymiss老师：
    为了看您这个东西，今天从网上下载了 shell的属性和方法，好好学习了一遍，且在excel中引用后，对象、访求、属性都能查到。
    您的代码也没错啊，可是，运行后，没出错也没结果，是我的参数错了？今天一直在试，就是没结果
    另外，也尝试用getobject取的文件对象objfile，可这个函数就是出错，但换成excel\word却正常了，难道getobject函数的使用范围有限制？

dongdonggege

比如，我的D盘，有"火柴大师.ZIP"需要解压，我用的是“好压”。
我使用的方法：

1. Sub Test()
   
2.     Dim objShell As Object
   
3.     Dim objFolder As Object
   
4.     Dim objFile As Object
   
5. 
   
6.     Set objShell = CreateObject("shell.application")
   
7.     Set objFolderItem = objShell.NameSpace("D:").Items().Item("火柴大师.zip")
   
8.     Set objFIVs = objFolderItem.Verbs()
   
9.     For i = 0 To objFIVs.count - 1
   
10.         'MsgBox objFIVs.Item(i)
    
11.         Set objFIV = objFIVs.Item(i)
    
12.         If objFIV.Name = "解压到当前文件夹(&X)" Then '右键菜单中在中文系统是"打开(&O)"，英文自己改'"解压到 火柴大师\(&E)"
    
13.         objFIV.DoIt
    
14.         Exit For
    
15.         End If
    
16.     Next
    
17. End Sub

复制代码

那么“火柴大师”几个文件，就解压到当前文件夹。方法特别牛，是一个大师研究的。