Überprüfen, ob Datei in "Eigene Dateien" liegt

Sub aktueller_pfad() If Application.ActiveWorkbook.Path = Environ("homepath") _ Then MsgBox "Aktueller Pfad ist 'Eigene Dateien'" Else MsgBox "Aktueller Pfad ist n i c h t 'Eigene Dateien'" End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub aktueller_pfad() xx = Environ("homedrive") & Environ("homepath") yy = Application.ActiveWorkbook.Path If xx = yy Then MsgBox "Aktueller Pfad ist 'Eigene Dateien'" Else MsgBox "Aktueller Pfad ist n i c h t 'Eigene Dateien'" End If End Sub

Hi,
über Environ bekommst du nur die Standardpfade. So kommst du an die tatsächlichen:

Option Explicit

Public Declare Function SHGetPathFromIDList Lib "shell32.dll" ( _
    ByVal pidl As Long, _
    ByVal pszPath As String) As Long
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" ( _
    ByVal hWndOwner As Long, _
    ByVal nFolder As Long, _
    ByRef pidl As tpItemIDList) As Long
Public Declare Function CoTaskMemFree Lib "ole32.dll" ( _
    ByRef hMem As Long) As Long

Public Const CSIDL_CONTROLLS = &H3
Public Const CSIDL_COOKIES = &H21
Public Const CSIDL_COMMON_ADMINTOOLS = &H2F
Public Const CSIDL_COMMOM_ALTSTARTUP = &H1E
Public Const CSIDL_COMMON_APPDATA = &H23
Public Const CSIDL_COMMON_DESKTOPDIREKTORY = &H19
Public Const CSIDL_COMMON_DOCUMENTS = &H2E
Public Const CSIDL_COMMON_FAVORITES = &H1F
Public Const CSIDL_COMMON_MUSIC = &O35
Public Const CSIDL_COMMON_PICTURES = &O36
Public Const CSIDL_COMMON_PROGRAMS = &O17
Public Const CSIDL_COMMON_STARTMENU = &H16
Public Const CSIDL_COMMON_STARTUP = &H18
Public Const CSIDL_COMMON_TEMPLATES = &H20
Public Const CSIDL_COMMON_VIDEO = &H2D
Public Const CSIDL_DESKTOP = &H0
Public Const CSIDL_DESKTOPDIRECTORY = &H10
Public Const CSIDL_FAVORITES = &H6
Public Const CSIDL_FONTS = &H14
Public Const CSIDL_HISTORY = &H22
Public Const CSIDL_INTERNET_CACHE = &H20
Public Const CSIDL_INTERNET = &H1
Public Const CSIDL_DRIVES = &H11
Public Const CSIDL_PERSONAL = &H5
Public Const CSIDL_NETWORK = &H12
Public Const CSIDL_NETHOOD = &H13
Public Const CSIDL_PRINTERS = &H4
Public Const CSIDL_PRINTHOOD = &H1B
Public Const CSIDL_PROGRAMS = &H2
Public Const CSIDL_RECENT = &H8
Public Const CSIDL_BITBUCKET = &HA
Public Const CSIDL_SENDTO = &H9
Public Const CSIDL_STARTMENU = &HB
Public Const CSIDL_STARTUP = &H7
Public Const CSIDL_TEMPLATES = &H15
Public Const CSIDL_WINDOWS = &H24

Public Enum enSpecialFolders
    spControlPanel = CSIDL_CONTROLLS
    spCookies = CSIDL_COOKIES
    spCommonAdminTools = CSIDL_COMMON_ADMINTOOLS
    spCommonAltStartup = CSIDL_COMMOM_ALTSTARTUP
    spCommonAppData = CSIDL_COMMON_APPDATA
    spCommonDesktopDirectory = CSIDL_COMMON_DESKTOPDIREKTORY
    spCommonDocuments = CSIDL_COMMON_DOCUMENTS
    spCommonFavorites = CSIDL_COMMON_FAVORITES
    spCommonMusic = CSIDL_COMMON_MUSIC
    spCommonPictures = CSIDL_COMMON_PICTURES
    spCommonPrograms = CSIDL_COMMON_PROGRAMS
    spCommonStartmenu = CSIDL_COMMON_STARTMENU
    spCommonStartup = CSIDL_COMMON_STARTUP
    spCommonTemplates = CSIDL_COMMON_TEMPLATES
    spCommonVideo = CSIDL_COMMON_VIDEO
    spDesktopUser = CSIDL_DESKTOP
    spDesktopDir = CSIDL_DESKTOPDIRECTORY
    spFavorites = CSIDL_FAVORITES
    spFonts = CSIDL_FONTS
    spHistory = CSIDL_HISTORY
    spInternetCache = CSIDL_INTERNET_CACHE
    spInternetVirtualFolder = CSIDL_INTERNET
    spMyComputerDrives = CSIDL_DRIVES
    spMyDocuments = CSIDL_PERSONAL
    spNetWorkRoot = CSIDL_NETWORK
    spNetHood = CSIDL_NETHOOD
    spPrinters = CSIDL_PRINTERS
    spPrintHood = CSIDL_PRINTHOOD
    spStatMenuPrograms = CSIDL_PROGRAMS
    sprecent = CSIDL_RECENT
    spRecycleBin = CSIDL_BITBUCKET
    spSendTo = CSIDL_SENDTO
    spStartMenu = CSIDL_STARTMENU
    spStartup = CSIDL_STARTUP
    spTemplates = CSIDL_TEMPLATES
    spWindows = CSIDL_WINDOWS
End Enum

Public Type tpShortItemId
    cb As Long
    abID As Byte
End Type

Public Type tpItemIDList
    mkid As tpShortItemId
End Type

Public Function GetSpecialFolder(lngSpecialFolder As enSpecialFolders) As String
    Dim lngRet As Long
    Dim strPath As String
    Dim typIDL As tpItemIDList
    lngRet = SHGetSpecialFolderLocation(0, lngSpecialFolder, typIDL)
    If lngRet = 0 Then
        strPath = Space(512)
        lngRet = SHGetPathFromIDList(ByVal typIDL.mkid.cb, ByVal strPath)
        Call CoTaskMemFree(typIDL.mkid.cb)
        If lngRet Then GetSpecialFolder = Left(strPath, InStr(strPath, Chr(0)) - 1) & "\"
    End If
End Function

Public Sub test()
    MsgBox GetSpecialFolder(spMyDocuments)
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Überprüfen, ob Datei in "Eigene Dateien" liegt

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Überprüfen, ob Datei in "Eigene Dateien" liegt

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread