Question

'假设我有一个文件test.zip，在这个文件里面是test.vbs和其他一些文件。 '我已将此zipfile作为附件附加并发送。 '现在在MS Outlook中我双击zipfile打开它，我现在想要的是'能够直接从打开的窗口运行这个test.vbs文件，指向 - 'C：\ Users \ username \ AppData \ Local \ Microsoft \ Windows \ Temporary Internet Files \ Content.Outlook '\ test.zip并将文件复制到指定的文件夹。

strZIPname = "test.zip"
strFileDest = "c:\test\"

Function UnPack(strZIPdest, strZIPname)
  Dim intOptions, objShell, objSource, objTarget

  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objShell = CreateObject("Shell.Application")
  Set objSource = objShell.NameSpace(strZIPname)
  Set objTarget = objShell.NameSpace(strZIPdest)

 intOptions = 16
 If objFSO.FolderExists(strZIPdest) Then
   objTarget.CopyHere objSource.Items.item("calendar.jpg"), intOptions 'error occurs here
   'objTarget.CopyHere objSource.Items.item("facebook.jpg"), intOptions
   'objTarget.CopyHere objSource.Items.item("linkedin.jpg"), intOptions
   'objTarget.CopyHere objSource.Items.item("main_logo.png"), intOptions
   'objTarget.CopyHere objSource.Items.item("twitter.jpg"), intOptions
 Else
   MsgBox "Cannot complete unzip for " & strZIPname & ". The destination directory (" & strZIPdest & ") could not be located.", 0, "Invalid"
 End If
  Set objFSO = Nothing
  Set objShell = Nothing
  Set objSource = Nothing
  Set objTarget = Nothing
End Function

'此代码仅在桌面上存在zip文件时才有效，否则我会收到错误消息 - '对象要求：'objsource'

Answer 1

您必须首先保存VBS文件 - 您的硬盘驱动器上的任何位置，只有在此之后您才能运行它。

Answer 2

'这现在有效。我不得不使用expanddenviroment来获取userprofile，然后添加其余的路径，以便vbscript找到zip文件的路径。另外在最后删除'文件夹中的zipfile，否则windows会创建相同zipfile的副本。如果有人有更好的方法，请发布您的代码，谢谢。

Dim objFSO, objWsh
Set objWsh = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
userprofilePath = objWsh.ExpandEnvironmentStrings("%USERPROFILE%")
strPath = userprofilePath & "\AppData\Local\Microsoft\Windows\Temporary Internet Files\Content.Outlook\"
'wscript.echo strpath
appDataPath = objWsh.ExpandEnvironmentStrings("%APPDATA%")
pathToCopyTo = appDataPath & "\Microsoft\Signatures\"
strFileDest = pathToCopyTo
'wscript.echo strfiledest
strZIPname1 = "unzip6.zip"
strZIPname2 = "unzip6 (2).zip"
strZIPname3 = "unzip6 (3).zip"

Call Search (strPath)
WScript.Echo"Done."
Set objWsh = Nothing
Set objFSO = Nothing
Set objShell = Nothing

Sub Search(str)
    Dim objFolder, objSubFolder, objFile, intOptions, objShell, objSource, objTarget
    Set objFolder = objFSO.GetFolder(str)
    For Each objFile In objFolder.Files
        'If objFile.DateLastModified < (Now() - 30) Then
            if objfile.name = strZIPname1 or objfile.name = strZIPname2 or objfile.name = strZIPname3 then
                'wscript.echo "File found at this path: " & str&"\"&objfile.name
                'Set objFSO = CreateObject("Scripting.FileSystemObject")
                Set objShell = CreateObject("Shell.Application")
                Set objSource = objShell.NameSpace(str&"\"&objfile.name)
                Set objTarget = objShell.NameSpace(strFileDest)
                intOptions = 16
                If objFSO.FolderExists(strFileDest) Then
                objTarget.CopyHere objSource.Items.item("calendar.jpg"), intOptions
                objTarget.CopyHere objSource.Items.item("facebook.jpg"), intOptions
                objTarget.CopyHere objSource.Items.item("linkedin.jpg"), intOptions
                objTarget.CopyHere objSource.Items.item("main_logo.png"), intOptions
                objTarget.CopyHere objSource.Items.item("twitter.jpg"), intOptions
                Else
                MsgBox "Cannot complete unzip for " & strZIPname & ". The destination directory (" & strZIPdest & ") could not be located.", 0, "Invalid"
                End If
            objFile.Delete(True)
        End If
    Next
    For Each objSubFolder In objFolder.SubFolders
        Search(objSubFolder.Path)
    Next
Set objFolder = Nothing
'Set objFSO = Nothing
Set objShell = Nothing
Set objSource = Nothing
Set objTarget = Nothing
End Sub

是否可以从一个zip文件中运行一个vbscript，它是outlook中的附件并提取文件？

2 个答案: