本文介绍了将包含文件的文件夹解压缩到所选位置的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!
问题描述
团队,我正在努力从VBA代码中提取zip文件,但出现错误,这是我的代码:
Team, I am working upon extract the zip file from VBA code but getting error, here is my code:
Sub Un_Zip_File() Dim flname As String Call PathCall flname = Dir(impathn & "Transactions*.zip") Call PathCall Call UnZip_File(impathn, flname) End Sub Sub UnZip_File(strTargetPath As String, fname As Variant) Dim oApp As Object, FSOobj As Object Dim FileNameFolder As Variant If Right(strTargetPath, 1) <> Application.PathSeparator Then strTargetPath = strTargetPath & Application.PathSeparator End If FileNameFolder = strTargetPath 'destination folder if it does not exist Set FSOobj = CreateObject("Scripting.FilesystemObject") If FSOobj.FolderExists(FileNameFolder) = False Then FSOobj.CreateFolder FileNameFolder End If Set oApp = CreateObject("Shell.Application") oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(fname).Items Set oApp = Nothing Set FSOobj = Nothing Set FileNameFolder = Nothing End Sub当我运行Un_zip_file宏时,出现错误:
When I am running Un_zip_file macro, I am getting error:
对象变量或未设置块变量
Object variables or with block variable not set
调试后继续
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(fname).Items推荐答案
这是如何解压缩文件的另一个示例.宏将zip文件解压缩到固定文件夹中"C:\test\"
Here is another example how to unzip a file. the macro unzip the zip file in a fixed folder"C:\test\"
Sub Unzip() Dim FSO As Object Dim oApp As Object Dim Fname As Variant Dim FileNameFolder As Variant Dim DefPath As String Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _ MultiSelect:=False) If Fname = False Then 'Do nothing Else 'Destination folder DefPath = "C:\test\" ' Change to your path / variable If Right(DefPath, 1) <> "\" Then DefPath = DefPath & "\" End If FileNameFolder = DefPath ' 'Delete all the files in the folder DefPath first if you want ' On Error Resume Next ' Kill DefPath & "*.*" ' On Error GoTo 0 'Extract the files into the Destination folder Set oApp = CreateObject("Shell.Application") oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items MsgBox "You find the files here: " & FileNameFolder On Error Resume Next Set FSO = CreateObject("scripting.filesystemobject") FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True End If End Sub更多推荐
将包含文件的文件夹解压缩到所选位置
发布评论