All geek questions in one place

GetOpenFileNameW in VBA?

Well, I can step back from the base, but I would like to use the wide (Unicode) version of the API call for GetOpenFileName to return a list of several files.

Now the reason I want to do this: When selecting multiple files, the general character limit for file names depends on the version of the function.
• ANSI: 32k limit
• Unicode: no restrictions

Returning a large number of files from a directory deeply immersed in my network can quickly exceed the ANSI 32k character limit.

So what I did was take my working declared ANSI function and replace all declared string variables with lngptr . Then, when I need to assign values ​​to these, I used the StrPtr() function to convert string values.

Now, when I try to call this function, when it gets to the part where it calls the function Declared lReturn = GetOpenFileNameU(OpenFile) , it actually does nothing !. There are no errors, nothing - just steps right behind this line, and nothing happens. What did I do wrong?

This is where I am now:

 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
+5
source share
1 answer

Your current problem looks like OpenFile.lStructSize = LenB(strFile)

Since you set strFile to 257, it contains 574 bytes. Based on the results, it seems that lStructSize will only work if it matches the file exactly, so you should use your original OpenFile.lStructSize = LenB(OpenFile)

Also, I don't think strptr works the way you use it, it converts a string to a pointer, but not vice versa

I wrote a function that converts pointers to a string if this is really one of the problems. Unfortunately, this requires you to walk in length, I had a lot of problems trying to get it from the pointer itself.

 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
+1
source

Source: https://habr.com/ru/post/1205455/

More articles:


All Articles