How can I make this 32bit Function runs in both 32bit and 64bit?

E

ebbsamsung

Registered User.
Local time
Today, 11:18
Joined
May 22, 2014
Messages
19
Sir,

Here I am again for this problem, I adapted a code running in 32bit MS Access but now I faced this problem if possible to make this code runs in both 32bit and 64bit when they use this database. Is is possible like this?
If 64bit run this code else32bit run this code. How can I make it proper if its possible? Could you please help me?:o

Thank you in advance!

Here is the code:
Code: 
Option Compare Database
Option Explicit

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Const WM_SETICON = &H80
Private Const IMAGE_ICON = 1
Private Const LR_LOADFROMFILE = &H10
Private Const SM_CXSMICON As Long = 49
Private Const SM_CYSMICON As Long = 50

Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Function SetFormIcon(hWnd As Long, strIconPath As String) As Boolean
Dim lIcon As Long
Dim lResult As Long
Dim X As Long, Y As Long

X = GetSystemMetrics(SM_CXSMICON)
Y = GetSystemMetrics(SM_CYSMICON)
lIcon = LoadImage(0, strIconPath, 1, X, Y, LR_LOADFROMFILE)
lResult = SendMessage(hWnd, WM_SETICON, 0, ByVal lIcon)

End Function
 
You need to do conditional compiling which will detect the 'bitness' and use the appropriate code.
You will need to modify the three declaration lines & possibly the hwnd As Long argument in your function
I'm typing this on a tablet so can't modify your code easily.

However there's a very good guide to conditional compilation at Phillip Stiefel's website: http://codekabinett.com/rdumps.php?Lang=2&targetDoc=windows-api-declaration-vba-64-bit

The site is in both German & English & has many very informative articles - well worth a read
 
This is possible if your form is pop up
Code: 
Option Compare Database
Option Explicit


Private Const WM_SETICON = &H80
Private Const IMAGE_ICON = 1
Private Const LR_LOADFROMFILE = &H10
Private Const SM_CXSMICON As Long = 49
Private Const SM_CYSMICON As Long = 50

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As LongPtr, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
        Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    #Else
        Private Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
        Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    #End If
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#Else
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#End If
#If Win64 Then
    Public Function SetFormIcon(hWnd As LongPtr, strIconPath As String) As Boolean
    Dim lIcon As LongPtr
    Dim lResult As LongPtr
#Else
    Public Function SetFormIcon(hWnd As Long, strIconPath As String) As Boolean
    Dim lIcon As Long
    Dim lResult As Long
#End If
Dim X As Long, Y As Long

X = GetSystemMetrics(SM_CXSMICON)
Y = GetSystemMetrics(SM_CYSMICON)
lIcon = LoadImage(0, strIconPath, 1, X, Y, LR_LOADFROMFILE)
lResult = SendMessage(hWnd, WM_SETICON, 0, ByVal lIcon)

End Function
 
Is the purpose of this code to set a specific icon for your forms?
If so, it can be done without code from Access Options ... Current Database
 
Sir Arnelgp,

I used the code but during compiling it marked red this part but no error occur. Please check sir arnel for me whats wrong.

Code: 
Option Compare Database
Option Explicit


Private Const WM_SETICON = &H80
Private Const IMAGE_ICON = 1
Private Const LR_LOADFROMFILE = &H10
Private Const SM_CXSMICON As Long = 49
Private Const SM_CYSMICON As Long = 50

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As LongPtr, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
        Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    #Else
        Private Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
        Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    #End If
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#Else
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#End If
#If Win64 Then
    Public Function SetFormIcon(hWnd As LongPtr, strIconPath As String) As Boolean
    Dim lIcon As LongPtr
    Dim lResult As LongPtr
#Else
    Public Function SetFormIcon(hWnd As Long, strIconPath As String) As Boolean
    Dim lIcon As Long
    Dim lResult As Long
#End If
Dim X As Long, Y As Long

X = GetSystemMetrics(SM_CXSMICON)
Y = GetSystemMetrics(SM_CYSMICON)
lIcon = LoadImage(0, strIconPath, 1, X, Y, LR_LOADFROMFILE)
lResult = SendMessage(hWnd, WM_SETICON, 0, ByVal lIcon)

End Function

Red Mark but no error line:

Code: 
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
 
Dont worry about the red ones it is ok since you are using x64 office.
 
Sir Arnelgp,

Thank you very much.....Actually, I am already finished simple db using 32bit Office and not considering the 64bit Office users. Then suddenly I was bumped into this when i try to run in another pc or laptop, then there it happened that they were using 64bit.

I have 3 modules affected by this 64 bit and I am planning to post it here all hoping the AWF admin and other experts here allow me and they will give me solution like yours since I am really a novice for this.

Sorry AWF admin and experts for my post, I am only looking some help by experts.

Thank you in advance experts!

Here are the functions affected by 64bit:

1)
Code: 
Private Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
Dim dwReturn As Long

Const SW_HIDE = 0
Const SW_SHOWNORMAL = 1
Const SW_SHOWMINIMIZED = 2
Const SW_SHOWMAXIMIZED = 3

Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, _
     ByVal nCmdShow As Long) As Long
     
Public Function fSetAccessWindow(Optional Procedure As String, Optional SwitchStatus As Boolean, Optional StatusCheck As Boolean) As Boolean
If Procedure = "Hide" Then
    dwReturn = ShowWindow(Application.hWndAccessApp, SW_HIDE)
End If
If Procedure = "Show" Then
    dwReturn = ShowWindow(Application.hWndAccessApp, SW_SHOWMAXIMIZED)
End If
If Procedure = "Minimize" Then
    dwReturn = ShowWindow(Application.hWndAccessApp, SW_SHOWMINIMIZED)
End If
If SwitchStatus = True Then
    If IsWindowVisible(hWndAccessApp) = 1 Then
        dwReturn = ShowWindow(Application.hWndAccessApp, SW_HIDE)
    Else
        dwReturn = ShowWindow(Application.hWndAccessApp, SW_SHOWMAXIMIZED)
    End If
End If
If StatusCheck = True Then
    If IsWindowVisible(hWndAccessApp) = 0 Then
        fSetAccessWindow = False
    End If
    If IsWindowVisible(hWndAccessApp) = 1 Then
        fSetAccessWindow = True
    End If
End If
End Function

2)
Code: 
Option Compare Database
Option Explicit

Dim fso As Object

 Private Declare Function apiShellExecute 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

Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 2            'Open Maximized
Public Const WIN_MIN = 3            'Open Minimized

Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&


'---------------------------------------------------

Function fHandleFile(stFile As String, lShowHow As Long)

On Error GoTo Err_Handler

Dim lRet As Long, varTaskID As Variant
Dim stRet As String
    'First try ShellExecute
    lRet = apiShellExecute(hWndAccessApp, vbNullString, _
            stFile, vbNullString, vbNullString, lShowHow)
            
    If lRet > ERROR_SUCCESS Then
        stRet = vbNullString
        lRet = -1
    Else
        Select Case lRet
            Case ERROR_NO_ASSOC:
                'Try the OpenWith dialog
                varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                        & stFile, WIN_NORMAL)
                lRet = (varTaskID <> 0)
            Case ERROR_OUT_OF_MEM:
                stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
            Case ERROR_FILE_NOT_FOUND:
                stRet = "Error: File not found.  Couldn't Execute!"
            Case ERROR_PATH_NOT_FOUND:
                stRet = "Error: Path not found. Couldn't Execute!"
            Case ERROR_BAD_FORMAT:
                stRet = "Error:  Bad File Format. Couldn't Execute!"
            Case Else:
        End Select
    End If
    
    fHandleFile = lRet & _
                IIf(stRet = "", vbNullString, ", " & stRet)
                
Exit_Handler:
    Exit Function
    
Err_Handler:
    MsgBox "Error " & Err.Number & " in fHandleFile procedure : " & Err.Description, vbOKOnly + vbCritical
    Resume Exit_Handler

End Function
 
Please study the information Phillip Stiefel's website using the link that I gave in post #2
That way you can learn how to solve issues with 64-bit compatibility for yourself

Also did you notice my question in post #4
 
Sir Ridders,

Thank you so much sir for your reply, I will definitely study when i leave this company by the end of the month. I am very sorry, I was in hurry to finished the simple db to be given to my boss before leaving.

Have a nice day!
 
This is the conversion
 

Attachments

Sir Arnelgp,

A million thanks sir arnelgp, it helps me alot....I can now sleep well tonight.:):):). I can now relax for few days before I leave the company.

To sir ridders and the other experts in this forum, THANK YOU SO MUCH:):)
 
Always remember, better to have no sleep than no wake up. Goodluckand see you more.
 
You must log in or register to reply here.

Similar threads

Gasman
32bit and 64bit?
Replies
4
Views
199
isladogs
isladogs
NauticalGent
Dual monitors, dual frustration
Replies
6
Views
361
isladogs
isladogs
A
Ensure releasing/closing of a handle without losing err-state in case
Replies
5
Views
468
Josef P.
J
S
Solved MS Access Navigationform moveable
Replies
1
Views
574
isladogs
isladogs
M
Getting pop-up form to center on monitor
2
Replies
23
Views
2,883
InstructionWhich7142
I

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom