Excel VBA テクニック集
Windowsディレクトリの取得

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

Public Function Get_Dir_Windows() As String
    Dim WinDir As String
    
    Get_Dir_Windows = ""
    WinDir = Space$(33)
    If GetWindowsDirectory(WinDir, Len(WinDir)) > 0 Then
        WinDir = Left$(WinDir, InStr(WinDir, vbNullChar) - 1)
        Get_Dir_Windows = WinDir
        End If
End Function

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

Public Function Get_Dir_System() As String
    Dim SysDir As String
    
    Get_Dir_System = ""
    SysDir = Space$(33)
    If GetSystemDirectory(SysDir, Len(SysDir)) > 0 Then
        SysDir = Left$(SysDir, InStr(SysDir, vbNullChar) - 1)
        Get_Dir_System = SysDir
        End If
End Function

Public Function Get_Dir_Desktop() As String
    Get_Dir_Desktop = CreateObject("WScript.Shell").SpecialFolders("Desktop")
End Function

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

Public Function Get_Dir_Temp() As String
    Dim strTemp As String
    Dim lpBuffer As String * 260
    
    strTemp = Environ("temp")
    If Dir(strTemp, vbDirectory) = "" Then
        strTemp = Environ("tmp")
        If Dir(strTemp, vbDirectory) = "" Then
            Call GetWindowsDirectory(lpBuffer, Len(lpBuffer))
            strTemp = Left(lpBuffer, InStr(lpBuffer, Chr$(0)) - 1) & "\Temp"
            If Dir(strTemp, vbDirectory) = "" Then
                strTemp = App.Path
                End If
            End If
        End If
    
    Get_Dir_Temp = strTemp
End Function