アクセルデータシステム | MS Access VBAコードサンプル

特殊ホルダーを参照する。

①Windows Script Host を使う

特殊フォルダを取得

②Win32API を使う

#1 Windowsディレクトリの取得

#2 Windows システムディレクトリのパスを取得

#3 Windows 一時フォルダの取得

#4 すべての特殊フォルダを取得

①Windows Script Host - WScript.Shellを使う

<使用例>

Sub WshShell()

    Dim WshShell As Object
    Set WshShell = CreateObject("WScript.Shell")
    
    With WshShell

        Debug.Print .GetSpecialFolder(0)                    'Windowsフォルダ
        Debug.Print .GetSpecialFolder(1)                    'Systemフォルダ
        Debug.Print .GetSpecialFolder(2)                    'Tempフォルダ

        Debug.Print .SpecialFolders("AllUsersDesktop")      'AllUsers デスクトップ
        Debug.Print .SpecialFolders("AllUsersStartMenu")    'AllUsers マイドキュメント
        Debug.Print .SpecialFolders("AllUsersPrograms")     'AllUsers Recentフォルダ
        Debug.Print .SpecialFolders("AllUsersStartup")      'AllUsers スタートアップフォルダ
        Debug.Print .SpecialFolders("Desktop")              'デスクトップ
        Debug.Print .SpecialFolders("Favorites")            'Favoritesフォルダ
        Debug.Print .SpecialFolders("Fonts")                'フォント
        Debug.Print .SpecialFolders("MyDocuments")          'マイドキュメント
        Debug.Print .SpecialFolders("NetHood")              'NetHoodフォルダ
        Debug.Print .SpecialFolders("PrintHood")            'PrintHoodフォルダ
        Debug.Print .SpecialFolders("Programs")             'Programsフォルダ
        Debug.Print .SpecialFolders("Recent")               'Recentフォルダ
        Debug.Print .SpecialFolders("SendTo")               'SendToフォルダ
        Debug.Print .SpecialFolders("StartMenu")            'スタートメニューフォルダ
        Debug.Print .SpecialFolders("Startup")              'スタートアップフォルダ
        Debug.Print .SpecialFolders("Templates")            'Templatesフォルダ
    
    End With

    Set WshShell = Nothing
End Sub

<実行結果>

C:\WINDOWS
C:\WINDOWS\system32
C:\DOCUME~1\...\LOCALS~1\Temp

C:\Documents and Settings\All Users\デスクトップ
C:\Documents and Settings\All Users\スタート メニュー
C:\Documents and Settings\All Users\スタート メニュー\プログラム
C:\Documents and Settings\All Users\スタート メニュー\プログラム\スタートアップ
C:\Documents and Settings\...\デスクトップ
C:\Documents and Settings\...\Favorites
C:\WINDOWS\Fonts
C:\Documents and Settings\...\My Documents
C:\Documents and Settings\...\NetHood
C:\Documents and Settings\...\PrintHood
C:\Documents and Settings\...\スタート メニュー\プログラム
C:\Documents and Settings\...\Recent
C:\Documents and Settings\...\SendTo
C:\Documents and Settings\...\スタート メニュー
C:\Documents and Settings\...\スタート メニュー\プログラム\スタートアップ
C:\Documents and Settings\...\Templates

>top

②Win32APIを使う

#1 Windowsディレクトリの取得
 #2 Windows システムディレクトリのパスを取得
 #3 Windows 一時フォルダの取得
 #4 すべての特殊フォルダを取得

#1 Windowsディレクトリの取得

GetWindowsDirectoryを使う

<使用例>

Declare Function GetWindowsDirectory Lib "kernel32" Alias _
    "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long


Sub Get_WindowsDirectory()
    Dim strBuffer As String, lngSize As Long
    
    strBuffer = String(255, vbNullChar) '文字列全体に Null 文字を設定します。
    lngSize = GetWindowsDirectory(strBuffer, 255)
    
    Debug.Print Left(strBuffer, InStr(1, strBuffer, vbNullChar) - 1) & Chr(92)
End Sub

<実行結果>

C:\WINDOWS\

>top

#2 Windows システムディレクトリのパスを取得

GetSystemDirectoryを使う

<使用例>

Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" _
    (ByVal lpBuffer As String, ByVal nSize As Long) As Long


Sub Get_SystemDirectory()
    Dim strBuffer As String, lngSize As Long
    
    strBuffer = String(255, vbNullChar) ' 文字列全体に Null 文字を設定します。
    lngSize = GetSystemDirectory(strBuffer, 255)

    Debug.Print Left(strBuffer, InStr(1, strBuffer, vbNullChar) - 1)
End Sub

<実行結果>

C:\WINDOWS\system32

>top

#3 Windows 一時フォルダの取得

GetTempPathを使う

<使用例>

Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
   (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
   
   
Sub Get_TempFolder()
    Dim strBuffer As String, lngBufferLength As Long
    
    strBuffer = String(255, vbNullChar) ' 文字列全体に Null 文字を設定します。
    lngBufferLength = GetTempPath(255, strBuffer)

    Debug.Print Left(strBuffer, InStr(1, strBuffer, vbNullChar) - 1)
End Sub

<実行結果>

C:\DOCUME~1\...\LOCALS~1\Temp\

>top

#4 すべての特殊フォルダを取得

SHGetSpecialFolderLocation・SHGetPathFromIDList を使う

<使用例>

'フォルダIDを取得する
Declare Function SHGetSpecialFolderLocation Lib "shell32" _
    (ByVal hwndOwner As Long, ByVal nFolder As Long, ppidl As Long) As Long
'フォルダIDからフォルダ名を取得する
Declare Function SHGetPathFromIDList Lib "shell32" _
    (ByVal pidl As Long, ByVal pszPath As String) As Long


Sub Get_SpecialFolder()

    Dim hWnd, lngCSIDL, lngPPIDL As Long
    Dim lngPIDL As Long, strPath As String

    For lngCSIDL = &H0 To &H3B

        lngPPIDL = SHGetSpecialFolderLocation(hWnd, lngCSIDL, lngPIDL)
    
        strPath = String(255, vbNullChar) ' 文字列全体に Null 文字を設定します。
        lngPIDL = SHGetPathFromIDList(lngPIDL, strPath)
        
        If lngPIDL = 1 Then
            Debug.Print "値：&H" & Hex(lngCSIDL) & "  " & _
			Left(strPath, InStr(1, strPath, vbNullChar) - 1)
        End If
        
    Next lngCSIDL
End Sub

<実行結果>［．．．］にはユーザー名が入ります。

値：&H0  C:\Documents and Settings\...\デスクトップ
値：&H2  C:\Documents and Settings\...\スタート メニュー\プログラム
値：&H5  C:\Documents and Settings\...\My Documents
値：&H6  C:\Documents and Settings\...\Favorites
値：&H7  C:\Documents and Settings\...\スタート メニュー\プログラム\スタートアップ
値：&H8  C:\Documents and Settings\...\Recent
値：&H9  C:\Documents and Settings\...\SendTo
値：&HB  C:\Documents and Settings\...\スタート メニュー
値：&HD  C:\Documents and Settings\...\My Documents\My Music
値：&HE  C:\Documents and Settings\...\My Documents\My Videos
値：&H10  C:\Documents and Settings\...\デスクトップ
値：&H13  C:\Documents and Settings\...\NetHood
値：&H14  C:\WINDOWS\Fonts
値：&H15  C:\Documents and Settings\...\Templates
値：&H16  C:\Documents and Settings\All Users\スタート メニュー
値：&H17  C:\Documents and Settings\All Users\スタート メニュー\プログラム
値：&H18  C:\Documents and Settings\All Users\スタート メニュー\プログラム\スタートアップ
値：&H19  C:\Documents and Settings\All Users\デスクトップ
値：&H1A  C:\Documents and Settings\...\Application Data
値：&H1B  C:\Documents and Settings\...\PrintHood
値：&H1C  C:\Documents and Settings\...\Local Settings\Application Data
値：&H1F  C:\Documents and Settings\All Users\Favorites
値：&H20  C:\Documents and Settings\...\Local Settings\Temporary Internet Files
値：&H21  C:\Documents and Settings\...\Cookies
値：&H22  C:\Documents and Settings\...\Local Settings\History
値：&H23  C:\Documents and Settings\All Users\Application Data
値：&H24  C:\WINDOWS
値：&H25  C:\WINDOWS\system32
値：&H26  C:\Program Files
値：&H27  C:\Documents and Settings\...\My Documents\My Pictures
値：&H28  C:\Documents and Settings\...
値：&H29  C:\WINDOWS\system32
値：&H2B  C:\Program Files\Common Files
値：&H2D  C:\Documents and Settings\All Users\Templates
値：&H2E  C:\Documents and Settings\All Users\Documents
値：&H2F  C:\Documents and Settings\All Users\スタート メニュー\プログラム\管理ツール
値：&H30  C:\Documents and Settings\...\スタート メニュー\プログラム\管理ツール
値：&H35  C:\Documents and Settings\All Users\Documents\My Music
値：&H36  C:\Documents and Settings\All Users\Documents\My Pictures
値：&H37  C:\Documents and Settings\All Users\Documents\My Videos
値：&H38  C:\WINDOWS\Resources
値：&H3B  C:\Documents and Settings\...\Local Settings\Application Data\Microsoft\CD Burning

>top

アクセルデータシステム | MS Access（アクセス）データベースシステムの受託開発

特殊ホルダーを参照する。

①Windows Script Host - WScript.Shellを使う

②Win32APIを使う

システム情報を参照