3

現在、既存のVb6プロジェクトにWindows 7のサポートを追加していますが、Vista以降のWindowsバージョンではサポートされていないSHGetFolderPathを使用して特別なフォルダーパスを見つける際に問題が発生しました。SHGetKnownFolderPathを使用する必要があることはわかっていますが、VB6でSHGetKnownFolderPathAPI呼び出しを使用して実装する良い例を見つけることができません。

4

4 に答える 4

5

Shellオブジェクトの使用が簡単 Microsoftはこのオブジェクトとの互換性に注意を払っていないため、遅延バインディングをお勧めします。

Const ssfCOMMONAPPDATA = &H23 
Const ssfLOCALAPPDATA = &H1c
Const ssfAPPDATA = &H1a
Dim strAppData As String 

strAppData = _ 
    CreateObject("Shell.Application").NameSpace(ssfAPPDATA).Self.Path
于 2011-04-11T19:50:00.590 に答える
2

次のコードを使用して、この記事vba/vb6 モジュールWINAPI32.basの先頭でAPI呼び出しを宣言します

Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
                    (ByVal hwndOwner As Long, ByVal nFolder As Long, _
                     pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
                        (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Type SHITEMID
    cb As Long
    abID As Byte
End Type
Private Type ITEMIDLIST
    mkid As SHITEMID
End Type

新しいパブリック関数を追加しました：

Public Function SHGetSpecialFolderLocationVB(ByVal lFolder As Long) As String
    Dim lRet As Long, IDL As ITEMIDLIST, sPath As String

    lRet = SHGetSpecialFolderLocation(100&, lFolder, IDL)
    If lRet = 0 Then
        sPath = String$(512, chr$(0))
        lRet = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)
        SHGetSpecialFolderLocationVB = Left$(sPath, InStr(sPath, chr$(0)) - 1)
    Else
        SHGetSpecialFolderLocationVB = vbNullString
    End If
End Function

WindowsバージョンVista以降をチェックするための新機能を追加しました

Public Function IsVistaOrHigher() As Boolean
    Dim osinfo As OSVERSIONINFO
    Dim retvalue As Integer
    Dim bVista As Boolean

    bVista = False

    osinfo.dwOSVersionInfoSize = 148
    osinfo.szCSDVersion = Space$(128)
    retvalue = GetVersionExA(osinfo)

    If osinfo.dwPlatformId = 2 Then
        If osinfo.dwMajorVersion >= 6 Then
            bVista = True
        End If
    End If
    IsVistaOrHigher = bVista
End Function

SHGetFolderPathを呼び出す前のメソッドを変更しました

Public Function SHGetFolderPathVB(ByVal lFolder As Long) As String
    Dim path As String
    If IsVistaOrHigher() Then
        SHGetFolderPathVB = SHGetSpecialFolderLocationVB(lFolder)
    Else
        path = Space$(MAX_PATH)
        SHGetFolderPath 0, lFolder, 0, SHGFP_TYPE_CURRENT, path
        SHGetFolderPathVB = Left(path, InStr(path, vbNullChar) - 1)
    End If
End Function

よく働く！

于 2011-04-11T17:29:02.193 に答える
2

SHGetFolderPathfromの使用は、 shfolder.dllVistaおよびWin7で正常に機能します。

Private Declare Function SHGetFolderPath Lib "shfolder" Alias "SHGetFolderPathA" (ByVal hWnd As Long, ByVal csidl As Long, ByVal hToken As Long, ByVal dwFlags As Long, ByVal szPath As String) As Long

CSIDL_Xxx次に、これらの定数の列挙型を宣言します。

Public Function GetSpecialFolder(ByVal eType As MySpecialFolderType) As String
    GetSpecialFolder = String(1000, 0)
    Call SHGetFolderPath(0, eType, 0, 0, GetSpecialFolder)
    GetSpecialFolder = Left$(GetSpecialFolder, InStr(GetSpecialFolder, Chr$(0)) - 1)
End Function
于 2011-04-12T07:02:35.910 に答える
0

非常に遅い答え。ただし、実際にはSHGetKnownFolderPathx64 VBAでの使用方法を示しており、それを回避するための回避策はありません。

私はこのドイツ語のソースを使用しました：https ：//dbwiki.net/wiki/VBA_Tipp：_Spezielle_Verzeichnisse_ermitteln

そこに示されているソリューションは、x64Officeでは機能しません。だから私はそれを変えました。VBAからネイティブDLLを呼び出すには、

  • 新しいキーワードの使用法PtrSafe。
  • すべてのポインタのLongPtr代わりにの使用。Long
  • 関数を使用したVBA文字列のLongPtrオブジェクトへの変換StrPtr。
  • 通常は「W」でマークされたDLLのUnicodeバージョンを呼び出します。</li>

コード：

Public Const FOLDERID_ProgramFiles1  As String = "{905E63B6-C1BF-494E-B29C-65B732D3D21A}"

Public Type GUID
 Data1 As Long
 Data2 As Integer
 Data3 As Integer
 Data4(7) As Byte
End Type

Public Const S_OK As Long = 0
Public Const WIN32_NULL As Long = 0

Public Declare PtrSafe Sub CoTaskMemFree Lib "ole32" (ByVal hMem As LongPtr)

Public Declare PtrSafe Function CLSIDFromString Lib "ole32" ( _
  ByVal lpszGuid As LongPtr, _
  ByRef pGuid As GUID) As Long

Public Declare PtrSafe Function lstrlenW Lib "kernel32" ( _
 ByVal lpString As LongPtr) As Long

Public Declare PtrSafe Function SHGetKnownFolderPath Lib "shell32" ( _
  ByRef rfid As GUID, _
  ByVal dwFlags As Long, _
  ByVal hToken As Long, _
  ByRef pszPath As LongPtr) As Long

Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
 ByVal Destination As LongPtr, _
 ByVal Source As LongPtr, _
 ByVal length As Long)

Public Function GetBstrFromWideStringPtr(ByVal lpwString As LongPtr) As String
  Dim length As Long

  If (lpwString) Then length = lstrlenW(lpwString)
  If (length) Then
    GetBstrFromWideStringPtr = Space$(length)
    CopyMemory StrPtr(GetBstrFromWideStringPtr), lpwString, length * 2
  End If
End Function

Public Function GetKnownFolder(ByVal KnownFolderID As String) As String
'Returns empty String on any error.
  Dim ref As GUID
  Dim pszPath As LongPtr

  If (CLSIDFromString(StrPtr(KnownFolderID), ref) = S_OK) Then
    If (SHGetKnownFolderPath(ref, 0, WIN32_NULL, pszPath) = S_OK) Then
      GetKnownFolder = GetBstrFromWideStringPtr(pszPath)
      CoTaskMemFree pszPath
    End If
  End If
End Function

Sub TestKnownFolder()
 MsgBox GetKnownFolder(FOLDERID_ProgramFiles1)
End Sub

上記のリンクで、すべての文字列を見つけることができますFOLDERID_Blah。

于 2020-06-20T09:00:21.563 に答える