VBA 64bit / SHGetSpecialFolderLocation

  • Sonstige

Es gibt 18 Antworten in diesem Thema. Der letzte Beitrag () ist von mumpel.

    VBA 64bit / SHGetSpecialFolderLocation

    Hallo Leute,

    ich habe mein MS Office 2019 Prof. auf 64bit umgestellt.

    Nun habe ich aber ein Problem, mit dem Aufruf einer DLL-Funktion.

    VB.NET-Quellcode

    1. ' Ordner-Auflistung
    2. Public Enum SpecialFolderIDs
    3. sfidDESKTOP = &H0 ' Desktop
    4. sfidINTERNET = &H1 ' Internet Explorer (icon on desktop)
    5. sfidPROGRAMS = &H2 ' Start Menu\Programs
    6. sfidCONTROLS = &H3 ' My Computer\Control Panel
    7. sfidPRINTERS = &H4 ' My Computer\Printers
    8. sfidPERSONAL = &H5 ' My Documents
    9. sfidFAVORITES = &H6 ' \Favorites
    10. sfidSTARTUP = &H7 ' StartMenu\Programs\Startup
    11. sfidRECENT = &H8 ' \Recent
    12. sfidSENDTO = &H9 ' \SendTo
    13. sfidBITBUCKET = &HA ' \Recycle Bin
    14. sfidSTARTMENU = &HB ' \StartMenu
    15. sfidDESKTOPDIRECTORY = &H10 ' name>\Desktop
    16. sfidDRIVERS = &H11 ' My Computer
    17. sfidNETWORK = &H12 ' Network Neighborhood
    18. sfidNETHOOD = &H13 ' \nethood
    19. sfidFONTS = &H14 ' windows\fonts
    20. sfidTEMPLATES = &H15 ' Vorlagen
    21. sfidCOMMON_STARTMENU = &H16 ' All Users\StartMenu
    22. sfidCOMMON_PROGRAMS = &H17 ' AllUsers\Programs
    23. sfidCOMMON_STARTUP = &H18 ' AllUsers\Startup
    24. sfidCOMMON_DESKTOPDIRECTORY = &H19 ' AllUsers\Desktop
    25. sfidAPPDATA = &H1A ' name>\Application Data
    26. sfidPRINTHOOD = &H1B ' name>\PrintHood
    27. sfidLOCAL_APPDATA = &H1C ' name>\Local Settings\Applicaiton Data (non roaming)
    28. sfidALTSTARTUP = &H1D ' non localizedstartup
    29. sfidCOMMON_ALTSTARTUP = &H1E ' non localizedCommon startup
    30. sfidCOMMON_FAVORITES = &H1F
    31. sfidINTERNET_CACHE = &H20
    32. sfidCOOKIES = &H21
    33. sfidHISTORY = &H22
    34. sfidCOMMON_APPDATA = &H23 ' AllUsers\Application Data
    35. sfidWINDOWS = &H24 ' GetWindowsDirectory()
    36. sfidSYSTEM = &H25 ' GetSystemDirectory()
    37. sfidPROGRAM_FILES = &H26 ' C:\Program Files
    38. sfidMYPICTURES = &H27 ' C:\Program Files\My Pictures
    39. sfidMYDOCUMENTS = &H5 ' My Documents => s. a. sfidPERSONAL
    40. sfidPROFILE = &H28 ' USERPROFILE
    41. sfidSYSTEMX86 = &H29 ' x86 system directory on RISC
    42. sfidPROGRAM_FILESX86 = &H2A ' x86 C:\Program Files on RISC
    43. sfidPROGRAM_FILES_COMMON = &H2B ' C:\Program Files\Common
    44. sfidPROGRAM_FILES_COMMONX86 = &H2C ' x86 Program Files\Common on RISC
    45. sfidCOMMON_TEMPLATES = &H2D ' All Users\Templates
    46. sfidCOMMON_DOCUMENTS = &H2E ' All Users\Documents
    47. sfidCOMMON_ADMINTOOLS = &H2F ' All Users\Start Menu\Programs\Administrative Tools
    48. sfidADMINTOOLS = &H30 ' \Start Menu\Programs\Administrative Tools
    49. sfidProgramFiles = &H10000
    50. sfidCommonFiles = &H10001
    51. End Enum
    53. Private Type SHITEMID
    54. cb As Long
    55. abID As Byte
    56. End Type
    58. Private Type ITEMIDLIST
    59. mkid As SHITEMID
    60. End Type
    62. Private Declare PtrSafe Function GetUserName Lib "advapi32.dll" _
    63. Alias "GetUserNameA" (ByVal lpBuffer As String, _
    64. nSize As Long) As Long
    66. Private Declare PtrSafe Function GetTempPath Lib "kernel32.dll" Alias "GetTempPathA" _
    67. (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
    69. Private Declare PtrSafe Function SHGetSpecialFolderLocation Lib _
    70. "shell32.dll" (ByVal hwndOwner As Long, _
    71. ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
    73. Private Declare PtrSafe Function SHGetPathFromIDList Lib _
    74. "shell32.dll" Alias "SHGetPathFromIDListA" _
    75. (ByVal pidl As Long, ByVal pszPath As String) As Long
    77. ' Standard Systemordner ermitteln
    78. Public Function GetSpecialFolder(CSIDL As SpecialFolderIDs) As String
    80. ''Aufrufbeispiel:
    81. ''sPathDesktop = GetSpecialFolder(sfidDESKTOP)
    83. Dim lResult As Long
    84. Dim IDL As ITEMIDLIST
    85. Dim sPath As String
    87. 10 On Error GoTo GetSpecialFolder_Error
    89. 20 lResult = SHGetSpecialFolderLocation(100, CSIDL, IDL)
    90. 30 If lResult = 0 Then
    91. 40 sPath = Space$(512)
    92. 50 lResult = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)
    93. 60 GetSpecialFolder = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
    94. 70 End If
    96. 80 On Error GoTo 0
    97. 90 Exit Function
    99. GetSpecialFolder_Error:
    101. 100 MsgBox "Fehlernr.: " & Err.Number & " (" & Err.Description & ") in Prozedur GetSpecialFolder von Modul GetSystemOrdner", , "Fehler in Zeile: " & Erl
    102. End Function


    Und zwar stürzt mein Programm bei folgender Zeile ab in der Funktion GetSpecialFolder
    => 50 lResult = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)

    Hat einer eine Idee was hier noch zusätzlich geändert werden muss.
    Ich vermute es liegt an der Deklaration von

    VB.NET-Quellcode

    1. Private Type SHITEMID
    2. cb As Long
    3. abID As Byte
    4. End Type
    6. Private Type ITEMIDLIST
    7. mkid As SHITEMID
    8. End Type


    Ich hoffe jemand kann mir hier helfen.
    Vielen Dank im Voraus.

    Gruß Achilleus


    Hallo Leute,

    einfach die Suchanfrage in Google umgestellt und schon habe ich die Lösung:
    VBA - Office 365 x64 Bit - Vollständiger Absturz - Stack Overflow

    VB.NET-Quellcode

    1. Option Explicit
    3. ' Ordner-Auflistung
    4. Public Enum SpecialFolderIDs
    5. sfidDESKTOP = &H0 ' Desktop
    6. sfidINTERNET = &H1 ' Internet Explorer (icon on desktop)
    7. sfidPROGRAMS = &H2 ' Start Menu\Programs
    8. sfidCONTROLS = &H3 ' My Computer\Control Panel
    9. sfidPRINTERS = &H4 ' My Computer\Printers
    10. sfidPERSONAL = &H5 ' My Documents
    11. sfidFAVORITES = &H6 ' \Favorites
    12. sfidSTARTUP = &H7 ' StartMenu\Programs\Startup
    13. sfidRECENT = &H8 ' \Recent
    14. sfidSENDTO = &H9 ' \SendTo
    15. sfidBITBUCKET = &HA ' \Recycle Bin
    16. sfidSTARTMENU = &HB ' \StartMenu
    17. sfidDESKTOPDIRECTORY = &H10 ' name>\Desktop
    18. sfidDRIVERS = &H11 ' My Computer
    19. sfidNETWORK = &H12 ' Network Neighborhood
    20. sfidNETHOOD = &H13 ' \nethood
    21. sfidFONTS = &H14 ' windows\fonts
    22. sfidTEMPLATES = &H15 ' Vorlagen
    23. sfidCOMMON_STARTMENU = &H16 ' All Users\StartMenu
    24. sfidCOMMON_PROGRAMS = &H17 ' AllUsers\Programs
    25. sfidCOMMON_STARTUP = &H18 ' AllUsers\Startup
    26. sfidCOMMON_DESKTOPDIRECTORY = &H19 ' AllUsers\Desktop
    27. sfidAPPDATA = &H1A ' name>\Application Data
    28. sfidPRINTHOOD = &H1B ' name>\PrintHood
    29. sfidLOCAL_APPDATA = &H1C ' name>\Local Settings\Applicaiton Data (non roaming)
    30. sfidALTSTARTUP = &H1D ' non localizedstartup
    31. sfidCOMMON_ALTSTARTUP = &H1E ' non localizedCommon startup
    32. sfidCOMMON_FAVORITES = &H1F
    33. sfidINTERNET_CACHE = &H20
    34. sfidCOOKIES = &H21
    35. sfidHISTORY = &H22
    36. sfidCOMMON_APPDATA = &H23 ' AllUsers\Application Data
    37. sfidWINDOWS = &H24 ' GetWindowsDirectory()
    38. sfidSYSTEM = &H25 ' GetSystemDirectory()
    39. sfidPROGRAM_FILES = &H26 ' C:\Program Files
    40. sfidMYPICTURES = &H27 ' C:\Program Files\My Pictures
    41. sfidPROFILE = &H28 ' USERPROFILE
    42. sfidSYSTEMX86 = &H29 ' x86 system directory on RISC
    43. sfidPROGRAM_FILESX86 = &H2A ' x86 C:\Program Files on RISC
    44. sfidPROGRAM_FILES_COMMON = &H2B ' C:\Program Files\Common
    45. sfidPROGRAM_FILES_COMMONX86 = &H2C ' x86 Program Files\Common on RISC
    46. sfidCOMMON_TEMPLATES = &H2D ' All Users\Templates
    47. sfidCOMMON_DOCUMENTS = &H2E ' All Users\Documents
    48. sfidCOMMON_ADMINTOOLS = &H2F ' All Users\Start Menu\Programs\Administrative Tools
    49. sfidADMINTOOLS = &H30 ' \Start Menu\Programs\Administrative Tools
    50. sfidProgramFiles = &H10000
    51. sfidCommonFiles = &H10001
    52. End Enum
    54. Private Declare PtrSafe Function GetUserName Lib "advapi32.dll" _
    55. Alias "GetUserNameA" (ByVal lpBuffer As String, _
    56. nSize As Long) As Long
    58. Private Declare PtrSafe Function GetTempPath Lib "kernel32.dll" Alias "GetTempPathA" _
    59. (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
    61. Private Declare PtrSafe Function SHGetSpecialFolderLocation Lib "shell32.dll" _
    62. (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As LongPtr) As Long
    64. Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
    65. Alias "SHGetPathFromIDListA" (ByVal pidl As LongPtr, ByVal pszPath As String) As Boolean
    67. Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As LongPtr)
    69. Private Const S_OK As Long = 0
    70. Private Const MAX_LENGTH = 260
    72. Public Function GetSpecialFolder(ByVal CSIDL As Integer) As String
    73. Dim result As Long
    74. Dim path As String
    75. Dim idl_ptr As LongPtr
    77. 'Fill the IDL structure with the specified folder item.
    78. result = SHGetSpecialFolderLocation(0, CSIDL, idl_ptr)
    80. If result = S_OK Then
    81. 'Get the path from the IDL list, and return the folder adding final "\".
    82. path = Space$(MAX_LENGTH)
    83. If SHGetPathFromIDList(idl_ptr, path) Then
    84. GetSpecialFolder = Left$(path, InStr(path, vbNullChar) - 1) & "\"
    85. End If
    86. CoTaskMemFree idl_ptr
    87. End If
    88. End Function


    Gruß Achilleus

    Beiträge zusammengefügt. ~Thunderbolt

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Thunderbolt“ ()

    Nur der Vollständigkeit halber: learn.microsoft.com/de-de/wind…hgetspecialfolderlocation -> [SHGetSpecialFolderLocation wird nicht unterstützt und kann in Zukunft geändert oder nicht mehr verfügbar sein. Verwenden Sie stattdessen SHGetFolderLocation.]
    Mfg -Franky-

    @Achilleus Wenn Du dem Link von mir folgst, dann kommst Du zu SHGetFolderLocation -> learn.microsoft.com/de-de/wind…_core-shgetfolderlocation. Dort gibt es auf der Seite einen Hinweis: Ab Windows Vista ist diese Funktion lediglich ein Wrapper für SHGetKnownFolderIDList. Der CSIDL-Wert wird in den zugeordneten KNOWNFOLDERID-Wert übersetzt, und SHGetKnownFolderIDList wird aufgerufen. Neue Anwendungen sollten das bekannte Ordnersystem anstelle des älteren CSIDL-Systems verwenden, das nur aus Gründen der Abwärtskompatibilität unterstützt wird. Das führt dann hier her: learn.microsoft.com/de-de/wind…re-shgetknownfolderidlist -> SHGetKnownFolderIDList. Also Du kannst beide APIs verwenden wobei SHGetFolderLocation eben SHGetKnownFolderIDList auruft. Also falls Du nicht mehr für < WinVista entwickelst, solltest Du SHGetKnownFolderIDList verwenden.

    Auf die schnelle kann ich Dir nur VB6 Code anbieten. Sollte ja kein Problem sein PtrSafe und LongPtr für VBA entsprechend einzusetzen.
    Spoiler anzeigen

    Visual Basic-Quellcode

    1. Option Explicit
    3. Private Const S_OK As Long = &H0
    5. Private Const FOLDERID_Desktop As String = "{b4bfcc3a-db2c-424c-b029-7fe99a87c641}"
    7. Private Enum CSIDLS
    8. CSIDL_DESKTOP = &H0
    9. CSIDL_INTERNET = &H1
    10. CSIDL_PROGRAMS = &H2
    11. CSIDL_CONTROLS = &H3
    12. CSIDL_PRINTERS = &H4
    13. CSIDL_PERSONAL = &H5
    14. CSIDL_FAVORITES = &H6
    15. CSIDL_STARTUP = &H7
    16. CSIDL_RECENT = &H8
    17. CSIDL_SENDTO = &H9
    18. CSIDL_BITBUCKET = &HA
    19. CSIDL_STARTMENU = &HB
    20. CSIDL_MYDOCUMENTS = &H5
    21. CSIDL_MYMUSIC = &HD
    22. CSIDL_MYVIDEO = &HE
    23. CSIDL_DESKTOPDIRECTORY = &H10
    24. CSIDL_DRIVES = &H11
    25. CSIDL_NETWORK = &H12
    26. CSIDL_NETHOOD = &H13
    27. CSIDL_FONTS = &H14
    28. CSIDL_TEMPLATES = &H15
    29. CSIDL_COMMON_STARTMENU = &H16
    30. CSIDL_COMMON_PROGRAMS = &H17
    31. CSIDL_COMMON_STARTUP = &H18
    32. CSIDL_COMMON_DESKTOPDIRECTORY = &H19
    33. CSIDL_APPDATA = &H1A
    34. CSIDL_PRINTHOOD = &H1B
    35. CSIDL_LOCAL_APPDATA = &H1C
    36. CSIDL_ALTSTARTUP = &H1D
    37. CSIDL_COMMON_ALTSTARTUP = &H1E
    38. CSIDL_COMMON_FAVORITES = &H1F
    39. CSIDL_INTERNET_CACHE = &H20
    40. CSIDL_COOKIES = &H21
    41. CSIDL_HISTORY = &H22
    42. CSIDL_COMMON_APPDATA = &H23
    43. CSIDL_WINDOWS = &H24
    44. CSIDL_SYSTEM = &H25
    45. CSIDL_PROGRAM_FILES = &H26
    46. CSIDL_MYPICTURES = &H27
    47. CSIDL_PROFILE = &H28
    48. CSIDL_SYSTEMX86 = &H29
    49. CSIDL_PROGRAM_FILESX86 = &H2A
    50. CSIDL_PROGRAM_FILES_COMMON = &H2B
    51. CSIDL_PROGRAM_FILES_COMMONX86 = &H2C
    52. CSIDL_COMMON_TEMPLATES = &H2D
    53. CSIDL_COMMON_DOCUMENTS = &H2E
    54. CSIDL_COMMON_ADMINTOOLS = &H2F
    55. CSIDL_ADMINTOOLS = &H30
    56. CSIDL_CONNECTIONS = &H31
    57. CSIDL_COMMON_MUSIC = &H35
    58. CSIDL_COMMON_PICTURES = &H36
    59. CSIDL_COMMON_VIDEO = &H37
    60. CSIDL_RESOURCES = &H38
    61. CSIDL_RESOURCES_LOCALIZED = &H39
    62. CSIDL_COMMON_OEM_LINKS = &H3A
    63. CSIDL_CDBURN_AREA = &H3B
    64. CSIDL_COMPUTERSNEARME = &H3D
    65. End Enum
    67. Private Enum KNOWN_FOLDER_FLAG
    68. KF_FLAG_DEFAULT = &H0
    69. KF_FLAG_FORCE_APP_DATA_REDIRECTION = &H80000
    70. KF_FLAG_RETURN_FILTER_REDIRECTION_TARGET = &H40000
    71. KF_FLAG_FORCE_PACKAGE_REDIRECTION = &H20000
    72. KF_FLAG_NO_PACKAGE_REDIRECTION = &H10000
    73. KF_FLAG_FORCE_APPCONTAINER_REDIRECTION = &H20000
    74. KF_FLAG_NO_APPCONTAINER_REDIRECTION = &H10000
    75. KF_FLAG_CREATE = &H8000
    76. KF_FLAG_DONT_VERIFY = &H4000
    77. KF_FLAG_DONT_UNEXPAND = &H2000
    78. KF_FLAG_NO_ALIAS = &H1000
    79. KF_FLAG_INIT = &H800
    80. KF_FLAG_DEFAULT_PATH = &H400
    81. KF_FLAG_NOT_PARENT_RELATIVE = &H200
    82. KF_FLAG_SIMPLE_IDLIST = &H100
    83. KF_FLAG_ALIAS_ONLY = &H80000000
    84. End Enum
    86. Private Type GUID
    87. data1 As Long
    88. data2 As Long
    89. data3 As Long
    90. data4 As Long
    91. End Type
    93. Private Declare Sub ILFree Lib "Shell32.dll" (ByVal pidl As Long)
    95. Private Declare Function CLSIDFromString Lib "ole32.dll" ( _
    96. ByVal pstring As Long, _
    97. ByRef pCLSID As GUID) As Long
    98. ' bis WinVista
    99. Private Declare Function SHGetFolderLocation Lib "Shell32.dll" ( _
    100. ByVal hwnd As Long, _
    101. ByVal csidl As CSIDLS, _
    102. ByVal hToken As Long, _
    103. ByVal dwFlags As Long, _
    104. ByRef ppidl As Long) As Long
    106. ' ab WinVista ist SHGetFolderLocation ein Wrapper für SHGetKnownFolderIDList
    107. Private Declare Function SHGetKnownFolderIDList Lib "Shell32.dll" ( _
    108. ByRef rfid As GUID, _
    109. ByVal dwFlags As KNOWN_FOLDER_FLAG, _
    110. ByVal hToken As Long, _
    111. ByRef ppidl As Long) As Long
    113. ' SHGetKnownFolderIDList -> rfid As Guid -> KNOWNFOLDERID see: https://learn.microsoft.com/de-de/windows/win32/shell/knownfolderid
    114. ' or: https://www.magnumdb.com/search?q=FOLDERID_*
    116. Private Sub Command1_Click()
    118. Dim pidl As Long
    120. ' bis WinVista
    121. ' hToken -> see: https://learn.microsoft.com/de-de/windows/win32/api/shlobj_core/nf-shlobj_core-shgetfolderlocation
    122. If SHGetFolderLocation(0&, CSIDLS.CSIDL_DESKTOP, -1&, 0&, pidl) = S_OK Then
    124. Debug.Print pidl
    126. Call ILFree(pidl)
    127. End If
    129. ' ab WinVista
    130. ' hToken -> see: https://learn.microsoft.com/de-de/windows/win32/api/shlobj_core/nf-shlobj_core-shgetknownfolderidlist
    131. If SHGetKnownFolderIDList(Str2Guid(FOLDERID_Desktop), KF_FLAG_DEFAULT_PATH, -1&, pidl) = S_OK Then
    133. Debug.Print pidl
    135. Call ILFree(pidl)
    136. End If
    138. End Sub
    140. Private Function Str2Guid(ByVal strGUID As String) As GUID
    141. If Len(strGUID) = 38 Then
    142. Call CLSIDFromString(StrPtr(strGUID), Str2Guid)
    143. End If
    144. End Function

    Mfg -Franky-

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „-Franky-“ ()

    Hallo Franky,

    also ich bin einfach zu blöde für deinen Programmcode.
    Selbst wenn ich alles richtig auf 64bit umstelle, komme ich nicht an meine SpecialFolders.

    Ich muss auch gestehen, ich verstehe die Funktion auch nicht im Ansatz. Ich kann auch im INet nirgendwo ein Beispiel für den "richtigen" Ansatz finden. Alle Beispiele entsprechen immer meinem Ansatz, der ja auch einwandfrei funktioniert.

    Ich werde also solange es geht, meine Version nutzen.

    Vielen Dank für Deine Hilfe.

    Gruß Achilleus

    SHGetFolderLocation und SHGetSpecialFolderLocation sind von den Parametern her fast identisch. hwnd war schon immer reserved und wurde nie genutzt. SHGetFolderLocation hat halt 2 Parameter mehr. Genaueres zu den zusätzlichen Parametern steht ja in der MS-Doku. SHGetKnownFolderIDList benötigt halt, weil nie genutzt, keinen hwnd Parameter mehr. Dafür halt GUIDs für die abzufragenden Ordner anstelle der veralteten CSIDL-Werte.

    In Deinem Code verwendest ja bereits SHGetPathFromIDList und passend dazu (-> IDList) wäre SHGetKnownFolderIDList genau die richtige API.

    SHGetSpecialFolderLocation wird mit Sicherheit nicht so schnell aus der Shell.dll geworfen. Allein schon wegen der Abwärtskompatibilität nicht. Eventuell ist SHGetSpecialFolderLocation inzwischen auch nur noch ein Wrapper für SHGetFolderLocation der wiederum ein Wrapper für SHGetPathFromIDList ist. Verlassen darauf das das so bleibt, würde ich mich nicht. Im einfachsten Fall gibt SHGetSpecialFolderLocation dann irgendwann nur noch <> S_OK zurück und pidl bleibt 0.
    Mfg -Franky-

    Hallo Franky,

    genau das hatte ich ja mit deiner Funktion SHGetKnownFolderID versucht.
    Selbst dein Beispiel liefert mir ja noch nicht einmal den Pfad zum Desktop oder habe ich das ganze irgendwie falsch versanden?
    Aber du schreibst ja selbst, dass wohl so schnell meine Vorgehensweise aufgehoben wird. Von daher warte ich einfach ab. :D

    Gruß Achilleus

    Die Frage wäre jetzt, was gibt denn die API SHGetKnownFolderIDList als pidl/Ordner zurück? Du könntest auch anstelle von SHGetKnownFolderIDList -> pidl -> SHGetPathFromIDList -> Pfad/Ordner auch gleich die API SHGetKnownFolderPath verwenden.
    Mfg -Franky-

    Natürlich kann ich das auch mit VBS machen, aber ich dachte mir immer ein direkter API-Zugriff ist einfacher, da ja VBS doch auch nur ein Wrapper ist.

    Hier einmal eine Funktion zum Auflisten aller Folder:

    VB.NET-Quellcode

    1. ​
    2. Set objShell = CreateObject("Shell.Application")
    4. For i=0 to 255
    6.   Set objFolder = objShell.Namespace(i)
    8.   On Error Resume next
    9.   Set objFolderItem = objFolder.Self
    10.   On Error Resume Next
    11.   WScript.Echo i & " " &  objFolder.Title & " " & objFolderItem.Path
    12.   Set objFolder=Nothing 
    13. Next


    Und hier mit Konstanten zum Abruf eines speziellen Ordners:
    (leider kennt VBS keine Enumerationen)

    VB.NET-Quellcode

    1. ​
    2. Const sfidDESKTOP = &H0                  ' Desktop
    3. Const sfidINTERNET = &H1                  ' Internet Explorer (icon on desktop)
    4. Const sfidPROGRAMS = &H2                 ' Start Menu\Programs
    5. Const sfidCONTROLS = &H3                 ' My Computer\Control Panel
    6. Const sfidPRINTERS = &H4                 ' My Computer\Printers
    7. Const sfidPERSONAL = &H5                 ' My Documents
    8. Const sfidFAVORITES = &H6                ' \Favorites
    9. Const sfidSTARTUP = &H7                  ' StartMenu\Programs\Startup
    10. Const sfidRECENT = &H8                   ' \Recent
    11. Const sfidSENDTO = &H9                   ' \SendTo
    12. Const sfidBITBUCKET = &HA                ' \Recycle Bin
    13. Const sfidSTARTMENU = &HB                ' \StartMenu
    14. Const sfidDESKTOPDIRECTORY = &H10        ' name>\Desktop
    15. Const sfidDRIVERS = &H11                 ' My Computer
    16. Const sfidNETWORK = &H12                 ' Network Neighborhood
    17. Const sfidNETHOOD = &H13                 ' \nethood
    18. Const sfidFONTS = &H14                   ' windows\fonts
    19. Const sfidTEMPLATES = &H15               ' Vorlagen
    20. Const sfidCOMMON_STARTMENU = &H16        ' All Users\StartMenu
    21. Const sfidCOMMON_PROGRAMS = &H17         ' AllUsers\Programs
    22. Const sfidCOMMON_STARTUP = &H18          ' AllUsers\Startup
    23. Const sfidCOMMON_DESKTOPDIRECTORY = &H19 ' AllUsers\Desktop
    24. Const sfidAPPDATA = &H1A                 ' name>\Application Data
    25. Const sfidPRINTHOOD = &H1B               ' name>\PrintHood
    26. Const sfidLOCAL_APPDATA = &H1C           ' name>\Local Settings\Applicaiton Data (non roaming)
    27. Const sfidALTSTARTUP = &H1D              ' non localizedstartup
    28. Const sfidCOMMON_ALTSTARTUP = &H1E       ' non localizedCommon startup
    29. Const sfidCOMMON_FAVORITES = &H1F
    30. Const sfidINTERNET_CACHE = &H20
    31. Const sfidCOOKIES = &H21
    32. Const sfidHISTORY = &H22
    33. Const sfidCOMMON_APPDATA = &H23          ' AllUsers\Application Data
    34. Const sfidWINDOWS = &H24                 ' GetWindowsDirectory()
    35. Const sfidSYSTEM = &H25                  ' GetSystemDirectory()
    36. Const sfidPROGRAM_FILES = &H26           ' C:\Program Files
    37. Const sfidMYPICTURES = &H27              ' C:\Program Files\My Pictures
    38. Const sfidMYDOCUMENTS = &H5              ' My Documents => s. a. sfidPERSONAL
    39. Const sfidPROFILE = &H28                 ' USERPROFILE
    40. Const sfidSYSTEMX86 = &H29               ' x86 system directory on RISC
    41. Const sfidPROGRAM_FILESX86 = &H2A        ' x86 C:\Program Files on RISC
    42. Const sfidPROGRAM_FILES_COMMON = &H2B    ' C:\Program Files\Common
    43. Const sfidPROGRAM_FILES_COMMONX86 = &H2C ' x86 Program Files\Common on RISC
    44. Const sfidCOMMON_TEMPLATES = &H2D        ' All Users\Templates
    45. Const sfidCOMMON_DOCUMENTS = &H2E        ' All Users\Documents
    46. Const sfidCOMMON_ADMINTOOLS = &H2F       ' All Users\Start Menu\Programs\Administrative Tools
    47. Const sfidADMINTOOLS = &H30              ' \Start Menu\Programs\Administrative Tools
    48. Const sfidProgramFiles = &H10000
    49. Const sfidCommonFiles = &H10001
    51. Set objShell = CreateObject("Shell.Application")
    52. Set objFolder = objShell.Namespace(sfidMYDOCUMENTS)
    53. Set objFolderItem = objFolder.Self
    54. Wscript.Echo objFolderItem.Path


    Aber das soll es gewesen sein.
    Solange meine Funktion funktioniert, ist ja alles gut.

    Bei der Lösung von Franky kommt immer nur ein Leerstring bzw. eine 0 raus. Den Ansatz werde ich nicht mehr weiterverfolgen. Es mir einfach zu hoch.

    Gruß Achilleus

    Leider schreibt Achilleus nicht, was bei dem Versuch mit SHGetFolderLocation und/oder SHGetKnownFolderIDList für ein Ordner zurück gegeben wird. Ich könnte mir vorstellen das er die Doku in Bezug auf dwFlags und hToken nicht gelesen hat.
    Mfg -Franky-

    Hallo Franky,

    ich habe geschrieben, dass ich diese Funktionen nicht verstehe. Bei den API-Funktionen recycle ich das nur. Hier interessiert mich nur das Endergebnis. :P

    Ich habe Deine Funktion so übernommen, wie du Sie mir vorgegeben hast und ich habe diese einfach (?) auf x64 angepasst, aber der Aufruf gibt mir einfach gar nichts zurück. Kann schon sein, dass ich da noch mehr Parameter angeben muss, aber damit bin ich einfach überfordert.
    Sorry, mehr kann ich dazu nicht sagen.

    Sollte meine Programmroutine irgendwann einmal nicht mehr funktionieren, dann werde ich zu diesem Zeitpunkt eine andere Lösung finden müssen, und sei es über VBS-Code.

    Achilleus schrieb:

    ich habe geschrieben, dass ich diese Funktionen nicht verstehe.
    Ahh, dann kennst Du Dich mit APIs so gar nicht aus. Du kopierst Code aus dem Internet und freust Dich einfach das es das macht was es soll. Kann man machen. ;)

    Achilleus schrieb:

    ich habe diese einfach (?) auf x64 angepasst, aber der Aufruf gibt mir einfach gar nichts zurück.
    Evtl. ist bei der Anpassung für 64bit VBA etwas schief gelaufen und irgendwas gibt die API mit Sicherheit zurück. Und wenn es nur ein entsprechender Fehlercode, der <> S_OK, ist.

    Achilleus schrieb:

    Sollte meine Programmroutine irgendwann einmal nicht mehr funktionieren, dann werde ich zu diesem Zeitpunkt eine andere Lösung finden müssen, und sei es über VBS-Code.
    So schnell wird das nicht passieren das MS die alte Möglichkeit abschaltet. 3 Möglichkeiten hab ich Dir ja genannt wobei ich davon nur noch 2 Möglichkeiten nutzen würde.
    Mfg -Franky-

    Achilleus schrieb:

    da ja VBS doch auch nur ein Wrapper ist.

    Wie kommst Du auf VBS?

    -Franky- schrieb:

    Evtl.
    ist bei der Anpassung für 64bit VBA etwas schief gelaufen

    Ich kann mir vorstellen, dass in den Prozeduren nicht sauber angepasst wurde. Es genügt nicht, nur die Deklarationen anzupassen. Man muss auch die Variablen in den Prozeduren entsprechend anpassen.

Facebook
Telefonspende