Desktopのファイルを別フォルダにコピーしたい

質問

Desktop上のあるZIPファイル（例；zzz.zip）を別のフォルダ（例；DドライブのFolder1）にコピーして解凍する場合、下記のVBSで実行できると思いますが、これをDesktopの階層が異なる（後述の　xxxxx）不特定多数のPCで実施する場合、実行できない場合があります。

このためDesktopの階層が左右されないScriptにしたいのですが、模範Scriptを教えていただけないでしょうか。DesktopPathなどで対応すればできるのでは、と思いますが、なかなかうまくいきません。

使用PCのOSはWindows7（32ビット）です。

'-------------------------------------------------------------
DIR_Source = "C:\xxxxx\Desktop\zzz.zip"
DIR_Destination = "D:\Folder1"
Const FOF_Silent = &H04
Const FOF_NoConfirmation = &H10
Set objShell = CreateObject("Shell.Application")
Set FilesInZip = objShell.NameSpace(DIR_Source).items
Set objFolder = objShell.NameSpace(DIR_Destination)
If (Not objFolder Is Nothing) Then
objFolder.CopyHere FilesInZip, FOF_NoConfirmation + FOF_Silent
End If

回答No.3

NotFound404 · ベストアンサー

こんな感じでは？
※定数の宣言部分は省略しています。

Dim oFS
Dim oApp
Dim oZip
Dim oZipItem
Dim oZipTo
Dim retVal
Dim DTpath

DTpath = CreateObject("Wscript.Shell").Specialfolders("DeskTop") & "\"
toZipPath = "D:\_zipTestFolder"

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oApp = CreateObject("Shell.application")
Set oZip = oApp.NameSpace(DTPath & "test.zip") 'デスクトップにtest.zipがあるとして

'解凍先をセット
If oFs.FolderExists(toZipPath) = False Then
oFS.CreateFolder (toZipPath)
End If
Set oZipTo = oApp.NameSpace(toZipPath)

'解凍
oZipTo.CopyHere oZip.Items, FOF_NoConfirmation + FOF_Silent

oApp.shellExecute toZipPath '確認用

お礼

完璧です！　ありがとうございました！

回答No.2

NotFound404

v=createobject("wscript.shell").specialfolders("desktop")
msgbox v
では？

お礼

コメントを有難うございます。

補足

desktopのパスを取得して、質問の中で記したScriptの中に組み込みたいのですが、それがなかなかうまく実行しないので苦慮してます。

回答No.1

kawais070

http://okwave.jp/qa/q235894.html
上記のQ&Aが参考になりますでしょうか？

SHGetSpecialFolderLocationというWin32 APIでデスクトップのフォルダのPATHが取得できるようです。

VBSでWin32 APIを呼び出すには、以下の方法があります。
http://cx20.main.jp/blog/hello/2012/04/20/hello-win32-api-vbscript-world/
Excelを使うのが簡単かな？Excelなら大抵のパソコンには入っているし。

お礼

参考情報を有難うございます。

補足

フォルダのパス取得については私も検索していたのですが、私自身がVBSを先月から勉強し始めたばかりで、その活用がまだまだできません。
Dim DesktopPath
DesktopPath = WSHShell.SpecialFolders("Desktop")
を設定していくScriptにすればできると思ってますが、うまくいかないです。エクセルを使用せず、不特定多数の階層の異なるPCで、ワンクリックで実行できないでしょうか。