GetOpenFileNameW w języku VBA?

Question

OK, mogę być daleko poza bazą tutaj, ale chciałbym użyć szerokiej (Unicode) wersji wywołania API dla GetOpenFileName, aby zwrócić listę wielu plików.

Powodem, dla którego chcę to zrobić, jest: Przy wyborze wielu plików całkowity limit znaków dla nazw plików zależy od wersji funkcji.
• ANSI: 32k granica
• Unicode: brak ograniczeń

Zwracanie wybrane pliki z katalogu zakopane głęboko w mojej sieci mogą szybko przekroczyć granicę ANSI 32k znaków.

Więc, co zrobiłem, to weź moją działającą deklarowaną funkcję ANSI i zastąp wszystkie zadeklarowane zmienne string za pomocą . Następnie, gdy trzeba im przypisać wartości, użyłem funkcji StrPtr() do konwersji wartości łańcuchów.

Teraz, gdy próbuję wywołać tę funkcję, gdy dociera ona do części, w której wywołuje funkcję Zadeklarowane lReturn = GetOpenFileNameU(OpenFile), tak naprawdę nic nie robi !. Brak błędów, nic - tylko kroki tuż obok tej linii i nic się nie dzieje. Co zrobiłem źle??

To gdzie jestem teraz:

Option Explicit 
'***NOTE: _ 
    This class object requires the following references: _ 
     <NONE> 

'Declare the windows API function for GetOpenFileNameA 
'MSDN Reference: http://msdn.microsoft.com/en-us/library/windows/desktop/ms646927(v=vs.85).aspx 
Public Declare PtrSafe Function GetOpenFileNameU Lib "comdlg32.dll" Alias "GetOpenFileNameW" (pOpenfilename As OPENFILENAME) As Long 

Public Const OFN_ALLOWMULTISELECT As Long = &H200 
Public Const OFN_CREATEPROMPT As Long = &H2000 
Public Const OFN_ENABLEHOOK As Long = &H20 
Public Const OFN_ENABLETEMPLATE As Long = &H40 
Public Const OFN_ENABLETEMPLATEHANDLE As Long = &H80 
Public Const OFN_EXPLORER As Long = &H80000 
Public Const OFN_EXTENSIONDIFFERENT As Long = &H400 
Public Const OFN_FILEMUSTEXIST As Long = &H1000 
Public Const OFN_HIDEREADONLY As Long = &H4 
Public Const OFN_LONGNAMES As Long = &H200000 
Public Const OFN_NOCHANGEDIR As Long = &H8 
Public Const OFN_NODEREFERENCELINKS As Long = &H100000 
Public Const OFN_NOLONGNAMES As Long = &H40000 
Public Const OFN_NONETWORKBUTTON As Long = &H20000 
Public Const OFN_NOREADONLYRETURN As Long = &H8000& '*see comments 
Public Const OFN_NOTESTFILECREATE As Long = &H10000 
Public Const OFN_NOVALIDATE As Long = &H100 
Public Const OFN_OVERWRITEPROMPT As Long = &H2 
Public Const OFN_PATHMUSTEXIST As Long = &H800 
Public Const OFN_READONLY As Long = &H1 
Public Const OFN_SHAREAWARE As Long = &H4000 
Public Const OFN_SHAREFALLTHROUGH As Long = 2 
Public Const OFN_SHAREWARN As Long = 0 
Public Const OFN_SHARENOWARN As Long = 1 
Public Const OFN_SHOWHELP As Long = &H10 
Public Const OFN_ENABLESIZING As Long = &H800000 
Public Const OFS_MAXPATHNAME As Long = 260 

'Create a custom type that matches the OPENFILENAME structure 
'MSDN reference: http://msdn.microsoft.com/en-us/library/windows/desktop/ms646839(v=vs.85).aspx 
Public Type OPENFILENAME 
    lStructSize As Long 
    hwndOwner As LongPtr 
    hInstance As LongPtr 
    lpstrFilter As LongPtr 
    lpstrCustomFilter As LongPtr 
    nMaxCustFilter As Long 
    nFilterIndex As Long 
    lpstrFile As LongPtr 
    nMaxFile As Long 
    lpstrFileTitle As LongPtr 
    nMaxFileTitle As Long 
    lpstrInitialDir As LongPtr 
    lpstrTitle As LongPtr 
    flags As Long 
    nFileOffset As Integer 
    nFileExtension As Integer 
    lpstrDefExt As LongPtr 
    lCustData As Long 
    lpfnHook As LongPtr 
    lpTemplateName As LongPtr 
End Type 


'OFS_FILE_OPEN_FLAGS: 
'Can view explanation of flags here on the MSDN reference: http://msdn.microsoft.com/en-us/library/windows/desktop/ms646839(v=vs.85).aspx 
Public Const OFS_FILE_OPEN_FLAGS = _ 
       OFN_EXPLORER Or _ 
       OFN_LONGNAMES Or _ 
       OFN_CREATEPROMPT Or _ 
       OFN_NODEREFERENCELINKS 

'Windows version constants 
Private Const VER_PLATFORM_WIN32_NT As Long = 2 
Private Const OSV_LENGTH As Long = 76 
Private Const OSVEX_LENGTH As Long = 88 
Public OSV_VERSION_LENGTH As Long 

Public Const WM_INITDIALOG As Long = &H110 
Private Const SW_SHOWNORMAL As Long = 1 


Public Function BrowseForFile(strTitle As String, myFilter As String, Optional initialDir As String = "") As String 
'This function allows you to browse for files and returns a string containing the files selected 

'Declare variables 
    Dim OpenFile As OPENFILENAME 
    Dim lReturn  As Long 
    Dim strFile  As String 


'Set the file type filter 
    OpenFile.lpstrFilter = StrPtr(myFilter) 

'Set the filter index. This is the order of the filters available to select from in the dialog. 1= the first in the list (and currently active) 
    OpenFile.nFilterIndex = 1 

'Set the handle to the window that owns the dialog box 
    OpenFile.hwndOwner = 0 

'lpstrFile is a pointer to a string which contains the current directory followed by list of file names selected. _ 
'Create an empty string to use as buffer, it needs to be at least 256 chars plus a terminating NULL char 
    strFile = String(257, 0) 
'Pass the buffer string to the pointer 
    OpenFile.lpstrFile = StrPtr(strFile) 

'The size of nMaxFile = the size, in characters, of the string pointed to by lpstrFile (less one NULL character at the end) 
'The size of lStructSize = The length, in bytes, of the structure. Use size of (OPENFILENAME) for this parameter. 

'BEFORE we can set the above two properties, we need to heck which version of VBA we are working with (SW uses VBA7, Office uses VBA6) _ 
The # indiicates preprocessor command, which is processed prior to compilation, which ensures that the code compiles per the correct platform 
     #If VBA7 Then 
     'When environment is VBA7, use LenB (binary compare) 
      OpenFile.nMaxFile = LenB(strFile) - 1 
      OpenFile.lStructSize = LenB(strFile) 
     #Else 
     'When environment is anything else, use Len (text compare) 
      OpenFile.nMaxFile = Len(strFile) - 1 
      OpenFile.lStructSize = Len(strFile) 
     #End If 

'This points to a string containing just the file name and extension (without path info), whereas lpstrFile contains the path info also. 
    OpenFile.lpstrFileTitle = OpenFile.lpstrFile 
'This is to lpstrFileTile what nMaxFile is to lpstrFile 
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile 

    'Check if the calling procedure specified a starting directory 
     If initialDir <> "" Then OpenFile.lpstrInitialDir = StrPtr(StrConv(initialDir, vbUnicode)) 

'This will be the title of the window dialog, and is an argument that must be passed by the calling procedure 
    OpenFile.lpstrTitle = StrPtr(StrConv(strTitle, vbUnicode)) 

'Flags control how the window looks and acts. _ 
'Can view explanation of flags here on the MSDN reference: http://msdn.microsoft.com/en-us/library/windows/desktop/ms646839(v=vs.85).aspx 
    OpenFile.flags = OFS_FILE_OPEN_FLAGS + OFN_ALLOWMULTISELECT 

'Call the windows API function we delcared and get the return when it completes. 
    lReturn = GetOpenFileNameU(OpenFile) 

'Check the return, if 0 then no files selected or user cancelled 
    If lReturn = 0 Then 
     BrowseForFile = "" 
    Else 
    'lpstrFile contains the current directory followed by list of file names 
     BrowseForFile = strFile 
    End If 
End Function 

Answer 1

Twój obecny problem wydaje się być OpenFile.lStructSize = LenB(strFile)

Ponieważ ustawienie strFile do 257, zawiera 574 bajtów. Opierając się na wyniki, wygląda lStructSize będzie działać tylko wtedy, gdy plik pasuje dokładnie, więc trzeba użyć oryginał OpenFile.lStructSize = LenB(OpenFile)

Również nie sądzę strptr działa całkiem tak, jak go używać, to konwertuje ciąg znaków do wskaźnika, ale nie vice versa

Napisałem funkcję, która przekształca wskaźniki na ciąg znaków, jeśli jest to rzeczywiście jeden z problemów. Niestety wymaga to podania długości, miałem problem z pobraniem go ze wskaźnika

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) 

Function myConversion(lpstr As Long, lenStr As Integer) As String 
    Dim bStr() As Byte 
    On Error Resume Next 

    If lenStr Then 
     Dim lenBytes 
     lenBytes = (lenStr) * 2 
     ReDim bStr(0 To lenBytes - 1) As Byte 
     Call CopyMemory(bStr(0), ByVal lpstr, lenBytes) 

     Dim i 
     Dim s As String 
     For i = LBound(bStr) To UBound(bStr) Step 2 
      s = s & Chr(bStr(i)) 
     Next i 
    End If 

    myConversion = s 
End Function