我试图从另一篇文章(26486871)中修改VBA脚本。
脚本将下载一个Zip文件,解压一个文本文件并将数据导入Excel。
我不知道VBA,所以我将处理每个功能在一个时间。
在提取部分,我收到了以下行的运行时错误:
objOApp.Namespace(FileNameToUnzip).CopyHere objOApp.Namespace(varFileNameFolder).items, 256“运行时错误'91:对象变量或块变量未设置.”
在调试模式下,当我将光标悬停在变量上时,目录和文件名是正确的。我不知道什么是不确定的。我很感谢你的帮助。
Option Explicit
'Main Procedure
Sub DownloadExtractAndImport()
Dim url As String
Dim targetFolder As String, targetFileZip As String, targetFileTXT As String
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String
Dim newSheet As Worksheet
url = "http://www.example.com/data.zip"
targetFolder = Environ("TEMP") & "\" & RandomString(6) & "\"
MkDir targetFolder
targetFileZip = targetFolder & "data.zip"
targetFileTXT = targetFolder & "data.txt"
'1 download file
DownloadFile url, targetFileZip
'2 extract contents
Call UnZip(targetFileZip, targetFolder)
End Sub
Private Sub DownloadFile(myURL As String, target As String)
Dim WinHttpReq As Object
Dim oStream As Object
Set WinHttpReq = CreateObject("Msxml2.ServerXMLHTTP")
WinHttpReq.Open "GET", myURL, False
WinHttpReq.send
myURL = WinHttpReq.responseBody
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile target, 1 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
End Sub
Private Function RandomString(cb As Integer) As String
Randomize
Dim rgch As String
rgch = "abcdefghijklmnopqrstuvwxyz"
rgch = rgch & UCase(rgch) & "0123456789"
Dim i As Long
For i = 1 To cb
RandomString = RandomString & Mid$(rgch, Int(Rnd() * Len(rgch) + 1), 1)
Next
End Function
Private Function UnZip(PathToUnzipFileTo As Variant, FileNameToUnzip As Variant)
Dim objOApp As Object
Dim varFileNameFolder As Variant
varFileNameFolder = PathToUnzipFileTo
Set objOApp = CreateObject("Shell.Application")
objOApp.Namespace(FileNameToUnzip).CopyHere objOApp.Namespace(varFileNameFolder).items, 256
End Function发布于 2018-06-05 17:19:50
Dim mainFolder As String
Dim zipFolder As String
Dim destinationFolder As String
Dim oShell As Object
Dim oMainFolder As Object
Dim oDestinatioFolder As Object
Dim oZipFolder As Object
Dim oZipItems As Object代之以
Dim mainFolder As Variant
Dim zipFolder As Variant
Dim destinationFolder As Variant
Dim oShell As Object
Dim oMainFolder As Object
Dim oDestinatioFolder As Object
Dim oZipFolder As Object
Dim oZipItems As Object发布于 2016-07-27 15:01:38
Comintem是对的,您应该用添加的代码编辑您的旧问题,而不是发布一个几乎相同的新问题。也许保留这个问题,删除旧的问题。
为了回答您的问题,似乎您正在以错误的顺序将参数传递给您的UnZip函数。尝试将行更改为:
Call UnZip(targetFolder, targetFileZip)更新
在创建对象并将其属性/方法全部调用在一行时,很难诊断这些问题。从问题的性质来判断,似乎您的VBA知识并不特别广泛,您试图通过将不同的web代码组合在一起来构建一个可行的解决方案。判断这种方法不是我的立场,但我的建议是,如果你采用这种方法,一次只创建一个对象,然后一次调用它的方法。这将使诊断代码变得更加容易。
我试图重写代码中的元素,以向您展示如何做到这一点。这可能有点过分,但至少可以帮助您确定任何问题的确切位置。显然,将文件夹名更改为您自己的。
Dim mainFolder As String
Dim zipFolder As String
Dim destinationFolder As String
Dim oShell As Object
Dim oMainFolder As Object
Dim oDestinatioFolder As Object
Dim oZipFolder As Object
Dim oZipItems As Object
'Define the folder names
mainFolder = "C:\Users\User\Downloads\SO\" 'change to your own folder name
zipFolder = "sqlite-shell-win32-x86-3071700.zip" 'an old sqlite download = change to your name
destinationFolder = Left(zipFolder, Len(zipFolder) - 4) 'name of zip folder minus the '.zip'
'Create the new destination folder
MkDir mainFolder & destinationFolder
'Acquire the folder items
'create the shell object
Set oShell = CreateObject("Shell.Application")
'create the main folder object as Folder3 item
Set oMainFolder = oShell.Namespace(CVar(mainFolder)) 'argument must be a variant
'create the destination folder object as Folder3 item
Set oDestinatioFolder = oMainFolder.Items.Item(CVar(destinationFolder & "\")).GetFolder
'create the zip folder object as Folder3
Set oZipFolder = oMainFolder.Items.Item(CVar(zipFolder)).GetFolder
'Extract the zip folder items and write to desination folder
oDestinatioFolder.CopyHere oZipFolder.Items, 256https://stackoverflow.com/questions/38616187
复制相似问题