title image


Smiley Liegt hier...
Option Explicit

 

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _

Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal _

pszPath As String) As Long

 

Private Declare Function SHGetSpecialFolderLocation Lib _

"shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder _

As Long, pidl As ITEMIDLIST) As Long

 

Private Type ITEMIDLIST

    cb As Long

    abID As Byte

End Type

 

Const CSIDL_FLAG_CREATE = &H8000

Const CSIDL_FLAG_DONT_VERIFY = &H4000

Const CSIDL_ADMINTOOLS = &H30

Const CSIDL_ALTSTARTUP = &H1D

Const CSIDL_APPDATA = &H1A

Const CSIDL_BITBUCKET = &HA

Const CSIDL_COMMON_ADMINTOOLS = &H2F

Const CSIDL_COMMON_ALTSTARTUP = &H1D

Const CSIDL_COMMON_APPDATA = &H23

Const CSIDL_COMMON_DESKTOPDIRECTORY = &H19

Const CSIDL_COMMON_DOCUMENTS = &H2E

Const CSIDL_COMMON_FAVORITES = &H1F

Const CSIDL_COMMON_PROGRAMS = &H17

Const CSIDL_COMMON_STARTMENU = &H16

Const CSIDL_COMMON_STARTUP = &H18

Const CSIDL_COMMON_TEMPLATES = &H2D

Const CSIDL_CONTROLS = &H3

Const CSIDL_COOKIES = &H21

Const CSIDL_DESKTOP = &H0

Const CSIDL_DESKTOPDIRECTORY = &H10

Const CSIDL_DRIVES = &H11

Const CSIDL_FAVORITES = &H6

Const CSIDL_FONTS = &H14

Const CSIDL_HISTORY = &H22

Const CSIDL_INTERNET = &H1

Const CSIDL_INTERNET_CACHE = &H20

Const CSIDL_LOCAL_APPDATA = &H1C

Const CSIDL_MYPICTURES = &H27

Const CSIDL_NETHOOD = &H13

Const CSIDL_NETWORK = &H12

Const CSIDL_PERSONAL = &H5

Const CSIDL_PRINTERS = &H4

Const CSIDL_PRINTHOOD = &H1B

Const CSIDL_PROFILE = &H28

Const CSIDL_PROGRAM_FILES = &H26

Const CSIDL_PROGRAM_FILES_COMMON = &H2B

Const CSIDL_PROGRAM_FILES_COMMONX86 = &H2C

Const CSIDL_PROGRAM_FILESX86 = &H2A

Const CSIDL_PROGRAMS = &H2

Const CSIDL_RECENT = &H8

Const CSIDL_SENDTO = &H9

Const CSIDL_STARTMENU = &HB

Const CSIDL_STARTUP = &H7

Const CSIDL_SYSTEM = &H25

Const CSIDL_SYSTEMX86 = &H29

Const CSIDL_TEMPLATES = &H15

Const CSIDL_WINDOWS = &H24

Const NOERROR = 0

 

Private Sub Form_Load()

    Debug.Print GetPath(CSIDL_FAVORITES)

End Sub

 

Private Function GetPath(Num&) As String

    Dim Result&, Buff$

    Dim idl As ITEMIDLIST

 

    Result = SHGetSpecialFolderLocation(Me.hWnd, Num, idl)

    If Result = NOERROR Then

        Buff = Space$(512)

        Result = SHGetPathFromIDList(ByVal idl.cb, ByVal Buff)

        If Result Then GetPath = Left(Buff, InStr(Buff, vbNullChar) - 1)

    End If

 

End Function





Code eingefügt mit Syntaxhighlighter 1.9
Moderation is OK, but not to excess...



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: