I have the following code declared:
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
And i have a function to access it as follows:
Private Function ReadIniFileString(ByVal Sect As String, ByVal Keyname As String) As String
Dim Worked As Long
Dim RetStr As String * 128
Dim StrSize As Long
Dim iNoOfCharInIni As Long
Dim sIniString As String
Dim sProfileString As String
iNoOfCharInIni = 0
sIniString = ""
If Sect = "" Or Keyname = "" Then
MsgBox "Section Or Key To Read Not Specified !!!", vbExclamation, "INI"
Else
sProfileString = ""
RetStr = Space(128)
StrSize = Len(RetStr)
Worked = GetPrivateProfileString(Sect, Keyname, "", RetStr, StrSize, IniFileName)
If Worked Then
iNoOfCharInIni = Worked
sIniString = Left$(RetStr, Worked)
End If
End If
ReadIniFileString = sIniString
End Function
This works under 2007, but i get an error on Excel 2010 at the:
Worked = GetPrivateProfileString(Sect, Keyname, "", RetStr, StrSize, IniFileName)
i get an "Can't find sub or function error" I have seen on the web that i should be able to fix this via declaring the function at PtrSafe, and returning a LongPtr. I've done that but get the same results!
Any help please!
Thanks so much!
Russ
To make this work in a 64 bit version of Excell you need to add the PtrSafe Attribute to the function Declaration like so:
Declare PtrSafe Function GetPrivateProfileString Lib "kernel32" Alias...
You don't say whether Excel 2010 is 32 bits or 64. I'm not sure what would happen if a VBA module running in a 64 bit instance of Excel would do if it tried to call a 32 bit routine, and kernel32.dll is a 32 bit library. Since GetPrivatePorfileString is deprecated, I suspect it didn't get ported to the 64 bit counterpart of kernel32.dll.
This is the correct code. I hope works!
Private Declare PtrSafe Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" ( _
ByVal lpAppName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long) As Long
Related
my company moved from 32 bit excel to 64 and and now macros that used to pull cookies keeps crashing. I know about PtrSafe declaration, but this no longer works. K googled trying to find the correct declaration for it but can't seem to get it right. Maybe can someone point out where the LongLong or LongPtr needs to be used? Below code is my n-th try with no luck:
'clear current cookies
Private Declare PtrSafe Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" (ByVal hInternet As Long, ByVal lOption As Long, ByVal sBuffer As String, ByVal lBufferLength As Long) As LongPtr
'retrieve cookie
Private Declare PtrSafe Function InternetGetCookieEx Lib "wininet.dll" Alias "InternetGetCookieExA" (ByVal pchURL As String, ByVal pchCookieName As String, ByVal pchCookieData As String, ByRef pcchCookieData As Integer, ByVal dwFlags As Integer, ByVal lpReserved As Integer) As Boolean
Private Const INTERNET_OPTION_END_BROWSER_SESSION = 42
Private Const INTERNET_COOKIE_HTTPONLY As Integer = &H2000
Private Sub UserForm_Initialize()
Call InternetSetOption(0, INTERNET_OPTION_END_BROWSER_SESSION, 0, 0)
WebBrowser1.Silent = True
'WebBrowser1.Navigate "salesforce.com"
WebBrowser1.Navigate "salesforce.com"
End Sub
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
If URL Like "*/home.jsp*" Then
Call InternetGetCookieEx(URL, "sid", sessionId, 256, INTERNET_COOKIE_HTTPONLY, vbNull)
Unload Me
End If
End Sub
The answer is to check the Microsoft documentation for these commands. When you are calling native methods like this you will find the documentation is in C++ so we must do some translation.
We can also look at what Microsoft says about LongPtr.
LongPtr is not a true data type because it transforms to a Long in
32-bit environments, or a LongLong in 64-bit environments. Using
LongPtr enables writing portable code that can run in both 32-bit and
64-bit environments. Use LongPtr for pointers and handles.
In your case that will be at least the handle hInternet but I would also cover the buffer length to avoid overflow problems. I would also convert all Integers to Longs.
Private Declare PtrSafe Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" (ByVal hInternet As LongPtr, ByVal lOption As Long, ByVal sBuffer As String, ByVal lBufferLength As LongPtr) As LongPtr
Private Declare PtrSafe Function InternetGetCookieEx Lib "wininet.dll" Alias "InternetGetCookieExA" (ByVal pchURL As String, ByVal pchCookieName As String, ByVal pchCookieData As String, ByRef pcchCookieData As Long, ByVal dwFlags As Long, ByVal lpReserved As LongPtr) As Boolean
EDIT: Let's also declare lpReserved As LongPtr because it starts with lp, which could mean Long Pointer.
ERRORS YOU MUST GUARD FROM:
To avoid unhandled exceptions in native code, check the exceptions that this command can throw and guard against them before calling in to native methods.
Return code Description
ERROR_NO_MORE_ITEMS
There is no cookie for the specified URL and all its parents.
ERROR_INSUFFICIENT_BUFFER
The value passed in lpdwSize is insufficient to copy all the cookie
data. The value returned in lpdwSize is the size of the buffer
necessary to get all the data.
ERROR_INVALID_PARAMETER
One or more of the parameters is invalid.
The lpszUrl parameter is NULL.
I am trying to open the osk.exe from VBA within Excel 64 bit on Windows 10 64 bit.
I have pieced together the following code that works for 32bit Excel on 64bit Windows 10, but I don't know how to modify it to get it working again with 64bit Excel:
Option Explicit
Type SHELLEXECUTEINFO
cbSize As LongPtr
fMask As Long
hwnd As LongPtr
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As LongPtr
hProcess As Long
End Type
Public Declare PtrSafe Function ShellExecuteEx Lib "shell32.dll" _
(lpExecInfo As SHELLEXECUTEINFO) As LongPtr
Declare PtrSafe Function Wow64DisableWow64FsRedirection Lib "kernel32.dll" (ByRef ptr As LongPtr) As Boolean
Declare PtrSafe Function Wow64RevertWow64FsRedirection Lib "kernel32.dll" (ByRef ptr As LongPtr) As Boolean
Public Function KeyboardOpen()
Dim shInfo As SHELLEXECUTEINFO
Dim lngPtr As LongPtr
With shInfo
.cbSize = Len(shInfo)
.lpFile = "C:\Windows\Sysnative\cmd.exe" 'best to use Known folders here
.lpParameters = "/c start osk.exe"
.lpDirectory = "C:\windows\system32" 'best to use Known folders here
.lpVerb = "open"
.nShow = 0
End With
Call Wow64DisableWow64FsRedirection(lngPtr)
Call ShellExecuteEx(shInfo)
Call Wow64RevertWow64FsRedirection(lngPtr)
End Function
Sub OpenKeyboard()
Call KeyboardOpen
End Sub
I have found a solution. To get the 64bit Windows 10 On screen keyboard (osk.exe) to run, add the following code to a module to a 64bit Excel, then you can call OpenKeyboardSub from within your application:
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub OpenKeyboardSub()
ShellExecute 0, vbNullString, "osk.exe", vbNullString, "C:\", 1
End Sub
I am using the Excel vba execShell script from here to pull data from a web server using curl in Excel for Mac. It works very well on my own Mac (and a number of other Macs that I have been testing on).
However, on a friends Mac (same (latest) version of Mac OS and Excel 365) it fails. It seems that on his Mac the execShell returns empty strings.
I simplified the script and only run an echo command and experience the same behavior. This is the test script I am running
Private Declare PtrSafe Function popen Lib "libc.dylib" (ByVal command As String, ByVal mode As String) As LongPtr
Private Declare PtrSafe Function pclose Lib "libc.dylib" (ByVal file As LongPtr) As Long
Private Declare PtrSafe Function fread Lib "libc.dylib" (ByVal outStr As String, ByVal size As LongPtr, ByVal items As LongPtr, ByVal stream As LongPtr) As Long
Private Declare PtrSafe Function feof Lib "libc.dylib" (ByVal file As LongPtr) As LongPtr
Function execShell(ByVal command As String, Optional ByRef exitCode As Long) As String
Dim file As LongPtr
file = popen(command, "r")
If file = 0 Then
Exit Function
End If
While feof(file) = 0
Dim chunk As String
Dim read As Long
chunk = Space(50)
read = fread(chunk, 1, Len(chunk) - 1, file)
If read > 0 Then
chunk = Left$(chunk, read)
execShell = execShell & chunk
End If
Wend
exitCode = pclose(file)
End Function
Sub test_command()
Dim errorCode As Long
result = execShell("echo Value_returned", errorCode)
msgbox(result & " " & errorCode)
End Sub
On my Mac, test_command shows
Value_returned
0
on his Mac it only shows
0
result = "" returns True.
Any ideas what may cause this behavior?
Any workaround that does not require updates on my friends OS?
Thanks a lot.
The 2nd response to this post from dugsmith worked consistently for me on 64-bit mac and might work for you and your friend as well. Code repeated here with full credit to others!
Private Declare PtrSafe Function web_popen Lib "libc.dylib" Alias "popen" (ByVal command As String, ByVal mode As String) As LongPtr
Private Declare PtrSafe Function web_pclose Lib "libc.dylib" Alias "pclose" (ByVal file As LongPtr) As Long
Private Declare PtrSafe Function web_fread Lib "libc.dylib" Alias "fread" (ByVal outStr As String, ByVal size As LongPtr, ByVal items As LongPtr, ByVal stream As LongPtr) As Long
Private Declare PtrSafe Function web_feof Lib "libc.dylib" Alias "feof" (ByVal file As LongPtr) As LongPtr
Public Function executeInShell(web_Command As String) As String
Dim web_File As LongPtr
Dim web_Chunk As String
Dim web_Read As Long
On Error GoTo web_Cleanup
web_File = web_popen(web_Command, "r")
If web_File = 0 Then
Exit Function
End If
Do While web_feof(web_File) = 0
web_Chunk = VBA.Space$(50)
web_Read = web_fread(web_Chunk, 1, Len(web_Chunk) - 1, web_File)
If web_Read > 0 Then
web_Chunk = VBA.Left$(web_Chunk, web_Read)
executeInShell = executeInShell & web_Chunk
End If
Loop
web_Cleanup:
web_pclose (web_File)
End Function
Function getHTTP(sUrl As String, sQuery As String) As String
Dim sCmd As String
Dim sResult As String
Dim lExitCode As Long
sCmd = "curl --get -d """ & sQuery & """" & " " & sUrl
sResult = executeInShell(sCmd)
getHTTP = sResult
End Function
I have an Excel VBA project I'm in the process of adapting for 64-bit Office. In one part, I make calls to MultiByteToWideChar() using any of 20 or so different code pages. (So StrConv is not an alternative.)
This has been working for me for years in 32-bit Office using the following declare:
Declare Function MultiByteToWideChar Lib "kernel32" ( _
ByVal codepage As Long, _
ByVal dwFlags As Long, _
lpMultiByteStr As Any, _
ByVal cbMultiByte As Long, _
ByVal lpWideCharStr As Long, _
ByVal cchWideChar As Long _
) As Long
'params: UINT, DWORD, LPCSTR, int, LPWSTR, int
'return: int
But my adaptation to 64-bit is not: I get wrong results (e.g. an empty string where a non-empty string is expected), and frequent crashes. I'm using a declare that I got from the Microsoft-provided Win32API_PtrSafe.TXT file. (Of course, it could have bugs.)
So, I'm guessing something is not right in the declare statement or in how I'm making the call.
Here's a minimal sample that repro's:
'Windows API declarations
Public Const MB_PRECOMPOSED = &H1 'use precomposed chars
Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" ( _
ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpMultiByteStr As String, _
ByVal cchMultiByte As Long, _
ByVal lpWideCharStr As String, _
ByVal cchWideChar As Long _
) As Long
'params: UINT, DWORD, LPCSTR, int, LPWSTR, int
'return: int
' My function that calls MultiByteToWideChar
Private Function EncodedStringByteArrayToString(abStringData() As Byte, lngArrLen As Long, CodePage As Long) As String
Dim lngStrLen As Long, str As String
lngStrLen = MultiByteToWideChar(CodePage, MB_PRECOMPOSED, ByVal VarPtr(abStringData(1)), lngArrLen, 0&, 0)
str = String(lngStrLen, " ")
lngStrLen = MultiByteToWideChar(CodePage, MB_PRECOMPOSED, ByVal VarPtr(abStringData(1)), lngArrLen, StrPtr(str), lngStrLen)
EncodedStringByteArrayToString = str
End Function
' Sample routine to produce repro
Private Sub TestMB2WCBug()
Dim abStringData(1 To 9) As Byte
Dim resultString As String
abStringData(1) = 67
abStringData(2) = 111
abStringData(3) = 112
abStringData(4) = 121
abStringData(5) = 114
abStringData(6) = 105
abStringData(7) = 103
abStringData(8) = 104
abStringData(9) = 116
resultString = EncodedStringByteArrayToString(abStringData(), 9, 10000)
End Sub
This has been working for me for years in 32-bit Office
It could not possibly work with the Declare that you have shown.
MultiByteToWideChar expects an LPWSTR as the output buffer. VB performs automatic conversion from Unicode to ANSI when passing strings into Declared functions, so there is no way that the function would receive a pointer to a wide string buffer when lpWideCharStr is declared As String. At best, it would receive a buffer that is large enough so no buffer overflow would occur, and then VB would perform conversion back to Unicode when returning from the function, so you will end up with a double-unicode string.
lpMultiByteStr is not a string either, it's an array of bytes in some encoding.
The code inside EncodedStringByteArrayToString seems to know all that, because it correctly passes a byte array for lpMultiByteStr and an StrPtr for lpWideCharStr. This could have not happened with the current declaration of MultiByteToWideChar.
The declaration that is assumed by the code in EncodedStringByteArrayToString is:
Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" ( _
ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpMultiByteStr As LongPtr, _
ByVal cchMultiByte As Long, _
ByVal lpWideCharStr As LongPtr, _
ByVal cchWideChar As Long _
) As Long
Apparently you had that before, so just put it back.
I have a listbox called lstSerial and a textbox called txtSerials. What I want to do is search lstSerial for the string that's entered in txtSerials. I'm using VB6 in Microsoft Visual Basic 6.0, and I'm having a terrible time finding documentation.
Thanks.
#AlexK's answer is technically correct - yes - it will work, but it's not the preferred way to go. There is an API call for this very purpose:
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As _
Integer, ByVal lParam As Any) As Long
'constants for searching the ListBox
Private Const LB_FINDSTRINGEXACT = &H1A2
Private Const LB_FINDSTRING = &H18F
'function to get find an item in the Listbox
Public Function GetListBoxIndex(hWnd As Long, SearchKey As String, Optional FindExactMatch As Boolean = True) As Long
If FindExactMatch Then
GetListBoxIndex = SendMessage(hWnd, LB_FINDSTRINGEXACT, -1, ByVal SearchKey)
Else
GetListBoxIndex = SendMessage(hWnd, LB_FINDSTRING, -1, ByVal SearchKey)
End If
End Function
So you want to do this:
lstSerial.ListIndex = GetListBoxIndex(lstSerial.hWnd, txtSerials.Text)
Source
Docs; http://msdn.microsoft.com/en-us/library/aa267225(v=VS.60).aspx
dim find as string,i as long,found as boolean
find=txtSerials.text
for i=0 to lstserial.listcount - 1
if strcomp(find, lstSerial.list(i), vbTextcompare)=0 then
found = true
lstSerial.setfocus
lstSerial.listindex= i
exit for
end if
next
if not found then msgbox "not found ..."