特殊フォルダを取得（wsh.SpecialFolders）

2016/05/06

CreateObject 関数：特殊フォルダを取得（WSH.SpecialFolders）

Windows Scripting Host（WSH）のSpecialFolders プロパティを使うと、Windows の特殊フォルダ（マイドキュメントやデスクトップなど）のパスを取得することができます。WSH を使用するには、CreateObject 関数 を使用します。

【構文】

＜name で指定した特殊フォルダのパスを取得＞
Dim wsh [ As Object ]
Set wsh = CreateObject (“WScript.Shell”)
path = wsh.SpecialFolders(findex)

引数・戻り値

wsh ・・・ Windows Scripting Host（WSH）のオブジェクト

findex ・・・取得したい特殊フォルダ（文字列または値）を指定します。
※ 文字列を指定する場合は、“ で囲みます（”AllUsersDesktop”）。

文字列	値	内容
AllUsersDesktop	0	すべてのユーザーに共通のデスクトップ
AllUsersStartMenu	1	すべてのユーザーに共通のスタートメニュー
AllUsersPrograms	2	すべてのユーザーに共通のプログラムメニュー
AllUsersStartup	3	すべてのユーザーに共通のスタートアップ
Desktop	4	ログインユーザーのデスクトップ
AppData	5	ログインユーザーのアプリ用データ
PrintHood	6	ログインユーザーのプリンタ
Templates	7	ログインユーザーの新規作成のテンプレート
Fonts	8	フォント
NetHood	9	ログインユーザーのネットワーク
Desktop	10	ログインユーザーのデスクトップ
StartMenu	11	ログインユーザーのスタートメニュー
SendTo	12	ログインユーザーの送る
Recent	13	ログインユーザーの最近使ったファイル
Startup	14	ログインユーザーのスタートアップ
Favorites	15	ログインユーザーのお気に入り
MyDocuments	16	ログインユーザーのマイドキュメント
Programs	17	ログインユーザーのプログラムメニュー

path ・・・ findex で指定した特殊フォルダのパス

Windows 特殊フォルダ取得使用例

サンプルVBAソース

　
Sub Sample_SpecialFolder()

    Dim wsh As Object
    
    Set wsh = CreateObject("WScript.Shell")
    
    MsgBox wsh.specialfolders("AllUsersDesktop") & vbCrLf & _
           wsh.specialfolders("AllUsersStartMenu") & vbCrLf & _
           wsh.specialfolders(2) & vbCrLf & _
           wsh.specialfolders("MyDocuments")
    
    Set wsh = Nothing

End Sub

Sub Sample_SpecialFolder()

Dim wsh As Object

Set wsh = CreateObject("WScript.Shell")

MsgBox wsh.specialfolders("AllUsersDesktop") & vbCrLf & _

wsh.specialfolders("AllUsersStartMenu") & vbCrLf & _

wsh.specialfolders(2) & vbCrLf & _

wsh.specialfolders("MyDocuments")

Set wsh = Nothing

End Sub

実行結果

- Excel・ファイルの操作 CreateObject 関数, Excel・ファイルの操作, VBA基本, Windows Scripting Host, WSH, エクセルVBA

Comment

vvv より:

2018年3月26日 5:56 PM

はじめまして

デスクトップにMoro というフォルダがあります。
その中に123.txtと456.txtと789.txtという隠しファイルがあります。
そのファイルをProgram files (x86)のSakiというフォルダにコピーし、隠し属性を解除したいのですが可能でしょうか？
また、パソコン毎にユーザー名が変わります。
そして、メッセージボックスで
コピーする前にOKとキャンセルボタンを表示し、OKならばコピーし、コピーが終わると完了しました。とメッセージが出て、キャンセルならば中断しました。とメッセージが出るようにすることは、可能でしょうか？
VBSでしたいのですが可能でしょうか？
できればコードを提示して頂けるとありがたいです。
以上、上手く説明できませんがよろしくお願いします。

返信

サイト管理人より:

2018年3月26日 11:18 PM

コメントありがとうございます。
VBSは普段殆ど使わないのですが一応作ってみました。
多分管理者権限で実行しないとエラーが発生します（コピーに失敗）。
エラー処理は行っていません。

Option Explicit

Dim fso, wsh, fobj
Dim FileNameFrom, FileNameTo
Dim ArrayFileNames, myDir1, myDir2, f
Dim Result, Prompt, Buttons, Title

Set fso = CreateObject("Scripting.FileSystemObject")
Set wsh = CreateObject("WScript.Shell")

myDir1 = "\Moto\"
myDir2 = "\Saki\"
ArrayFileNames = Array("123.txt","456.txt","789.txt")

for each f in ArrayFileNames

    FileNameFrom = wsh.specialfolders("Desktop") & myDir1 & f

    if fso.FileExists(FileNameFrom) = true Then
	FileNameTo = "C:\Program Files (x86)" & myDir2 & f

	Prompt = f & Chr(13) & "コピーしますか？"
	Buttons = vbOKCancel + vbInformation + vbDefaultButton2
	Title = "VBS"

	Result = MsgBox(Prompt, Buttons, Title)

	If Result = vbOK Then
	    Call fso.CopyFile(FileNameFrom, FileNameTo)
	    set fobj = fso.GetFile(FileNameTo)
	    fobj.Attributes = 0
       	    MsgBox "コピーを完了しました"
	Else
            MsgBox "キャンセルしました"
	End If

    end if

next

Set fobj = Nothing
Set fso = Nothing
Set wsh = Nothing

Option Explicit

Dim fso, wsh, fobj

Dim FileNameFrom, FileNameTo

Dim ArrayFileNames, myDir1, myDir2, f

Dim Result, Prompt, Buttons, Title

Set fso = CreateObject("Scripting.FileSystemObject")

Set wsh = CreateObject("WScript.Shell")

myDir1 = "\Moto\"

myDir2 = "\Saki\"

ArrayFileNames = Array("123.txt","456.txt","789.txt")

for each f in ArrayFileNames

FileNameFrom = wsh.specialfolders("Desktop") & myDir1 & f

if fso.FileExists(FileNameFrom) = true Then

FileNameTo = "C:\Program Files (x86)" & myDir2 & f

Prompt = f & Chr(13) & "コピーしますか？"

Buttons = vbOKCancel + vbInformation + vbDefaultButton2

Title = "VBS"

Result = MsgBox(Prompt, Buttons, Title)

If Result = vbOK Then

Call fso.CopyFile(FileNameFrom, FileNameTo)

set fobj = fso.GetFile(FileNameTo)

fobj.Attributes = 0

MsgBox "コピーを完了しました"

Else

MsgBox "キャンセルしました"

End If

end if

Set fobj = Nothing

Set fso = Nothing

Set wsh = Nothing

返信

vvv より:

2018年3月27日 10:05 AM

ありがとうございます。
感謝、感激です。
管理人様の言う通り管理者権限で実行しないと、エラーになります。
管理者権限で実行することは、可能でしょうか？
また、今は、ファイル一つずつの確認してコピーですが、まとめて確認してコピーすることは可能でしょうか？
お手数をお掛けしますが見て頂けたら嬉しいです。

返信

サイト管理人より:

2018年3月27日 7:17 PM

前回も書きましたが、VBSは普段使いません。
一応自分の環境では動きました。

Option Explicit

Dim fso, wsh, fobj
Dim FileNameFrom, FileNameTo
Dim ArrayFileNames, myDir1, myDir2, f
Dim Result, Prompt, Buttons, Title
Dim obj

'管理者としてVBS実行
Set obj = Wscript.CreateObject("Shell.Application")
if Wscript.Arguments.Count = 0 then
    obj.ShellExecute "wscript.exe", WScript.ScriptFullName & " runas", "", "runas", 1
    Wscript.Quit
end if


Set fso = CreateObject("Scripting.FileSystemObject")
Set wsh = CreateObject("WScript.Shell")

myDir1 = "\Moto\"
myDir2 = "\Saki\"
ArrayFileNames = Array("123.txt","456.txt","789.txt")


Prompt = "コピーしますか？"
Buttons = vbOKCancel + vbInformation + vbDefaultButton2
Title = "VBS"

Result = MsgBox(Prompt, Buttons, Title)

If Result = vbOK Then
    for each f in ArrayFileNames
	FileNameFrom = wsh.specialfolders("Desktop") & myDir1 & f
	if fso.FileExists(FileNameFrom) = true Then
	    FileNameTo = "C:\Program Files (x86)" & myDir2 & f
	    'ファイルコピー実行
	    Call fso.CopyFile(FileNameFrom, FileNameTo)
	    set fobj = fso.GetFile(FileNameTo)
	    '属性を標準に変更
	    fobj.Attributes = 0
	end if
    next
    MsgBox "コピーを完了しました"
Else
    MsgBox "キャンセルしました"
End If

Set obj = Nothing
Set fobj = Nothing
Set fso = Nothing
Set wsh = Nothing

Option Explicit

Dim fso, wsh, fobj

Dim FileNameFrom, FileNameTo

Dim ArrayFileNames, myDir1, myDir2, f

Dim Result, Prompt, Buttons, Title

Dim obj

'管理者としてVBS実行

Set obj = Wscript.CreateObject("Shell.Application")

if Wscript.Arguments.Count = 0 then

obj.ShellExecute "wscript.exe", WScript.ScriptFullName & " runas", "", "runas", 1

Wscript.Quit

end if

Set fso = CreateObject("Scripting.FileSystemObject")

Set wsh = CreateObject("WScript.Shell")

myDir1 = "\Moto\"

myDir2 = "\Saki\"

ArrayFileNames = Array("123.txt","456.txt","789.txt")

Prompt = "コピーしますか？"

Buttons = vbOKCancel + vbInformation + vbDefaultButton2

Title = "VBS"

Result = MsgBox(Prompt, Buttons, Title)

If Result = vbOK Then

for each f in ArrayFileNames

FileNameFrom = wsh.specialfolders("Desktop") & myDir1 & f

if fso.FileExists(FileNameFrom) = true Then

FileNameTo = "C:\Program Files (x86)" & myDir2 & f

'ファイルコピー実行

Call fso.CopyFile(FileNameFrom, FileNameTo)

set fobj = fso.GetFile(FileNameTo)

'属性を標準に変更

fobj.Attributes = 0

end if

MsgBox "コピーを完了しました"

Else

MsgBox "キャンセルしました"

End If

Set obj = Nothing

Set fobj = Nothing

Set fso = Nothing

Set wsh = Nothing

返信

iP より:

2018年3月30日 1:31 PM

管理人さん
はじめまして
いつも参考にさせて頂いております。

「VBSは普段使いません。」とのことですが
質問させて下さい。

上のコピーのコードを参考に削除する方を作成しているのですが

C:\Program Files (x86)\bbb\b1.txt
C:\Program Files (x86)\bbb\b2.txt
C:\Program Files (x86)\ccc\c1.txt
C:\Program Files (x86)\ccc\c2.txt
C:\Program Files (x86)\ddd\d1.txt

このようにファイルがあります。

\bbb\、\ccc\、\ddd\の中に対象のファイルが一つでもあれば削除して
MsgBox “削除を完了しました”
\bbb\、\ccc\、\ddd\の中に対象のファイルが一つもなければ
MsgBox “ファイルがありません”

このようにしたいのですが、どのように修正すれば良いのでしょうか？
ご迷惑をお掛けいたしますが、ご教授願います。

以下コードです。
見て頂ければわかると思うのですが、最初にOKを押すと
「ファイルがありません」と表示され、
またOkを押すと「ファイルがありません」が続きます。
最後に「削除を完了しました」と表示されます。

Option Explicit

Dim fso, wsh
Dim FileNameFrom, FileNameTo
Dim ArrayFileNames, myDir1, myDir2, f
Dim Result, Prompt, Buttons, Title
Dim obj

‘管理者としてVBS実行
Set obj = Wscript.CreateObject(“Shell.Application”)
if Wscript.Arguments.Count = 0 then
obj.ShellExecute “wscript.exe”, WScript.ScriptFullName & ” runas”, “”, “runas”, 1
Wscript.Quit
end if

Set fso = CreateObject(“Scripting.FileSystemObject”)
Set wsh = CreateObject(“WScript.Shell”)

myDir1 = “\bbb\”
myDir2 = “\ccc\”
myDir2 = “\ddd\”

ArrayFileNames = Array(“b1.txt”,”b2.txt”,”c1.txt”,”c2.txt”,”d1.txt”)

Prompt = “削除しますか？”
Buttons = vbOKCancel + vbInformation + vbDefaultButton2
Title = “VBS”

Result = MsgBox(Prompt, Buttons, Title)

If Result = vbOK Then
for each f in ArrayFileNames
if fso.FileExists(FileNameTo) = true Then
FileNameTo = “C:\Program Files (x86)” & myDir1 & f
FileNameTo = “C:\Program Files (x86)” & myDir2 & f
FileNameTo = “C:\Program Files (x86)” & myDir3 & f

Call fso.CopyFile(FileNameTo, True) ‘ファイル削除実行
else
MsgBox “ファイルがありません”
end if
next
MsgBox “削除を完了しました”
Else
MsgBox “キャンセルしました”
End If

Set obj = Nothing
Set fso = Nothing
Set wsh = Nothing

返信

サイト管理人より:

2018年4月1日 8:51 PM

コメントありがとうございます。

>Call fso.CopyFile(FileNameTo, True) ‘ファイル削除実行

この部分ですが、
CopyFile メソッドは、ファイルをコピーするメソッドです。
削除するには、いくつか方法があるのですが、
DeleteFile メソッドなどを使います。
詳細は、FileSystemObject：ファイル・フォルダを削除する（DeleteFile メソッド,DeleteFolder メソッド）で説明しています。よかったら参考にしてみてください。
※ vbs ではエラーになる部分もあるかもしれないので注意してください。

※ファイルシステムオブジェクトに関しては、ファイルシステムオブジェクト（FileSystemObject）の使い方で説明しています。

また、以下の部分に関して

>\bbb\、\ccc\、\ddd\の中に対象のファイルが一つでもあれば削除して

「対象のファイル」がどういうものかわからなかったのですが、
\bbb\ の場合、b1.txt、b2.txt
\ccc\ の場合、c1.txt、c2.txt
\ddd\ の場合、d1.txt
上記ファイルが存在する場合、そのファイルを削除、それ以外のファイルは削除しない
という形でソースを書いています。

※正規表現に関しては、VBA で正規表現を使う（RegExp オブジェクト）で説明しています。
また、VBA では、Like演算子が使えるのですが、VBSでは使えないようです。

Option Explicit

Dim obj, reg, fso, cnt
Dim FileName
Dim ArrayFileNames, ArrayDirNames, f, d
Dim Result, Prompt, Buttons, Title

'管理者としてVBS実行
Set obj = Wscript.CreateObject("Shell.Application")
if Wscript.Arguments.Count = 0 then
    obj.ShellExecute "wscript.exe", WScript.ScriptFullName & " runas", "", "runas", 1
    Wscript.Quit
end if

'正規表現を使用
Set reg = CreateObject("VBScript.RegExp")

'ファイルやフォルダ等の操作を行う
Set fso = CreateObject("Scripting.FileSystemObject")

cnt = 0

'削除対象のファイルが存在するフォルダのフルパス名を配列 ArrayDirNames に格納
ArrayDirNames = Array("C:\Program Files (x86)\bbb\",_
                      "C:\Program Files (x86)\ccc\",_
                      "C:\Program Files (x86)\ddd\")

Prompt = "削除しますか？"
Buttons = vbOKCancel + vbInformation + vbDefaultButton2
Title = "VBS"

Result = MsgBox(Prompt, Buttons, Title)

if Result = vbOK Then
    '「OK」ボタンをクリックした時の処理

    for each d in ArrayDirNames
    '削除対象のファイル名を配列 ArrayFileNames に格納
        '※正規表現を使用してフォルダ名を確認
        reg.Pattern = ".*bbb.*"
        if reg.Test(d) then ArrayFileNames = Array("b1.txt","b2.txt")
        reg.Pattern = ".*ccc.*"
        if reg.Test(d) then ArrayFileNames = Array("c1.txt","c2.txt")
        reg.Pattern = ".*ddd.*"
        if reg.Test(d) then ArrayFileNames = Array("d1.txt")

        for each f in ArrayFileNames
            if fso.FileExists(d & f) = true then
                Call fso.DeleteFile(d & f)    'ファイルを削除
                cnt = cnt + 1                 '削除したファイルの数をカウント
            end if
        next
    next

    if cnt > 0 then
        '削除したファイル数が 1 以上の場合の処理
        MsgBox "削除を完了しました"
    else
        '削除ファイルが無かった場合の処理
        MsgBox "ファイルがありません"
    end if

else
    '「キャンセル」ボタンをクリックした時の処理
    MsgBox "キャンセルしました"

end if


Set obj = Nothing
Set reg = Nothing
Set fso = Nothing