＜VBA で WScript.ShellのSpecialFoldersプロパティを使ってみた＞
どうも、三流プログラマーのＫｅｎ３です。 今回は、 CreateObject("WScript.Shell") と、スクリプトのシェルを作成して、 SpecialFoldersプロパティを使って、 デスクトップの位置を取得してみたいと思います/* * １．今回のキッカケ */
フォルダーの選択処理を前に作成しました。 詳細は、フォルダーを選択してファイルリストを作成する http://www.ken3.org/vba/vba-folder.html を見てください。 'フォルダー選択ダイアログを表示して、リターン値で選択場所を返す 'キャンセルの時は文字列キャンセル、 'デスクトップの時は文字列を返す
Function getFOLDER() As String
Dim objShell As Object 'Shell
Dim objFolder As Object 'Shell32.Folder
Const strTitle = "フォルダを選択してください。"
'シェルのオブジェクトを作成する
Set objShell = CreateObject("Shell.Application")
'フォルダー参照に設定
Const lngRef = &H1
'ルートフォルダーをデスクトップに設定
'5でMy Documents、6でFavoritesなど
Const fldRoot = &H0
Set objFolder = _
objShell.BrowseForFolder(0, _
strTitle, lngRef, fldRoot)
'フォルダー名を取出し、リターン値をセット
If objFolder Is Nothing Then 'キャンセルチェック
getFOLDER = "キャンセル" 'リターン値にキャンセルをセット
Else
If objFolder.ParentFolder Is Nothing Then
getFOLDER = "デスクトップ"
Else
getFOLDER = objFolder.Items.Item.Path 'パスをセットする
End If
End If
Set objFolder = Nothing
Set objShell = Nothing
End Function |
Sub test()
Dim objWShell As Object 'WScript.Shell
Dim strDesktopPath As String 'デスクトップの場所
'Windows Script Hostのオブジェクトを作成する
Set objWShell = CreateObject("WScript.Shell")
'スペシャルフォルダ（特殊フォルダ）の場所を返す
strDesktopPath = objWShell.SpecialFolders("Desktop")
'確認メッセージの表示
MsgBox "DesktopのPathは[" & strDesktopPath & "]です"
End Sub |
Function getFOLDER() As String
Dim objShell As Object 'Shell
Dim objFolder As Object 'Shell32.Folder
Const strTitle = "フォルダを選択してください。"
'シェルのオブジェクトを作成する
Set objShell = CreateObject("Shell.Application")
'フォルダー参照に設定
Const lngRef = &H1
'ルートフォルダーをデスクトップに設定
'5でMy Documents、6でFavoritesなど
Const fldRoot = &H0
Set objFolder = _
objShell.BrowseForFolder(0, _
strTitle, lngRef, fldRoot)
'フォルダー名を取出し、リターン値をセット
If objFolder Is Nothing Then 'キャンセルチェック
getFOLDER = "" 'リターン値に""空文字列をセット
Else
If objFolder.ParentFolder Is Nothing Then '下位を未選択デスクトップ？
Dim objWShell As Object 'WScript.Shell
'シェルのオブジェクトを作成する
Set objWShell = CreateObject("WScript.Shell")
'デスクトップの場所を返す
getFOLDER = objWShell.SpecialFolders("Desktop")
'オブジェクトの開放
Set objWShell = Nothing
Else
getFOLDER = objFolder.Items.Item.Path 'パスをセットする
End If
End If
Set objFolder = Nothing
Set objShell = Nothing
End Function |
Sub 選択テスト()
Dim strWORK As String
strWORK = getFOLDER() 'フォルダーの選択関数を呼ぶ
If strWORK = "" Then '空文字””でキャンセルのチェック
MsgBox "キャンセル押されたよ"
Else
MsgBox "選択されたのは" & strWORK & "です"
End If
End Sub |
ここまで、読んでいただきどうもです。ここから下は、三流君のホームページの紹介・案内です
目的の情報が見つかったか？少々心配しつつ、、、
|
気になったジャンル↓を選択してください。 人気記事(来場者が多いTOP3): Excel関係: Access関係: その他：VBAの共通関数やテキストファイルの操作など 開発時の操作: [F1を押してHELPを見る]/ [Debug.Print と イミディエイトウインドウ]/ [実行時エラーでデバッグ]/ [ウォッチ式とSTOP]/ [参照設定を行う] 仕様書(設計書？) XXXX書類: [基本設計書や要求仕様書]/ [テスト仕様書 テストデータ]/ [バグ票]/ [関数仕様書]/ [流れは 入力・処理・出力] ※↑文章の味付けが変わっていて、お口に合うかわかりませんが。。。 |
Blogとリンク:[三流君の作業日記]/
[VBAやASPのサンプルコード]/
広告-[通販人気商品の足跡]