UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Code Not Working In One Db Out Of Three, Access 2016    
 
   
tina t
post Oct 5 2019, 08:09 PM
Post#1



Posts: 6,150
Joined: 11-November 10
From: SoCal, USA


hi folks, back again. i have some code that I've been running for a good ten years at least, in A97, in four different FE dbs. i converted three of the dbs to A2016, and this particular code ran without issue. i dumped all the objects from those three dbs into three new created-in-A2016-64bit dbs (due to another issue), and this bit of code continued to run without issue.

now I've converted my last FE db from A97 to A2016 today, and this same bit of code keeps erring out. i created a new A2016 db and dumped all the objects into it; the code continues to err out. my VBA references are identical to one of the other dbs that decompiles/recompiles/compacts and runs without flaw.

i don't get it. anybody got any ideas?

tia
tina

btw, i didn't write the code. i got it from...well, somewhere online or from a book, I'm sure, but neglected to document the source in my code at the time.

Class module:

CODE
Option Compare Database
Option Explicit



#If VBA7 And Win64 Then
'Private Declare PtrSafe Function
#Else
#End If



#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
   ByVal bRevert As Long) As Long
#Else
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, _
   ByVal bRevert As Long) As Long
#End If

#If VBA7 And Win64 Then
Private Declare PtrSafe Function EnableMenuItem Lib "user32" (ByVal hMenu As _
   Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
#Else
Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As _
   Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
#End If

#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetMenuItemInfo Lib "user32" Alias _
   "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal B As _
   Long, lpMenuItemInfo As MENUITEMINFO) As Long
#Else
Private Declare Function GetMenuItemInfo Lib "user32" Alias _
   "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal B As _
   Long, lpMenuItemInfo As MENUITEMINFO) As Long
#End If

Private Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wID As Long
    hSubMenu As Long
    hbmpChecked As Long
    hbmpUnchecked As Long
    dwItemData As Long
    dwTypeData As String
    cch As Long
End Type

Const MF_GRAYED = &H1&
Const MF_BYCOMMAND = &H0&
Const SC_CLOSE = &HF060&

Public Property Get Enabled() As Boolean
    Dim hWnd As Long
    Dim hMenu As Long
    Dim Result As Long
    Dim MI As MENUITEMINFO
    
    MI.cbSize = Len(MI)
    MI.dwTypeData = String(80, 0)
    MI.cch = Len(MI.dwTypeData)
    MI.fMask = MF_GRAYED
    MI.wID = SC_CLOSE
    hWnd = Application.hWndAccessApp
    hMenu = GetSystemMenu(hWnd, 0)
    Result = GetMenuItemInfo(hMenu, MI.wID, 0, MI)
    Enabled = (MI.fState And MF_GRAYED) = 0
End Property

Public Property Let Enabled(boolClose As Boolean)
    Dim hWnd As Long
    Dim wFlags As Long
    Dim hMenu As Long
    Dim Result As Long
    
    hWnd = Application.hWndAccessApp
    hMenu = GetSystemMenu(hWnd, 0)
    If Not boolClose Then
        wFlags = MF_BYCOMMAND Or MF_GRAYED
    Else
        wFlags = MF_BYCOMMAND And Not MF_GRAYED
    End If
    Result = EnableMenuItem(hMenu, SC_CLOSE, wFlags)
End Property

Standard module:
CODE
Public Function isResetXButton(ByVal bln As Boolean)

    Dim C As XButton
    Set C = New XButton
    
    C.Enabled = bln

End Function

when i try to compile the project, i get an error on the last line:

C.Enabled = bln

Attached File  Capture.PNG ( 10.56K )Number of downloads: 5

--------------------
"the wheel never stops turning"
Go to the top of the page
 
GroverParkGeorge
post Oct 5 2019, 08:18 PM
Post#2


UA Admin
Posts: 36,029
Joined: 20-June 02
From: Newcastle, WA


First thought is whether the references in that db are proper.

--------------------
My Real Name Is George. Grover Park Consulting is where I do business.
How to Ask a Good Question
Beginning SQL Server
Go to the top of the page
 
tina t
post Oct 5 2019, 08:56 PM
Post#3



Posts: 6,150
Joined: 11-November 10
From: SoCal, USA


hi, George, hope you're having a good weekend and thanks for posting back. my VBA references are identical to one of the other dbs that decompiles/recompiles/compacts and runs without flaw.

...

ha. well, the above is true, but it turns out that i don't know really where i copied my previous code from - i mean, from which of my own databases. i just went back and looked again at a copy of the last converted db i worked with (just finished it earlier today). some of the commented lines in the class module were different, so i just deleted the module from my problem db, and imported the same module from the "good" db. and now the problem db compiles.

i didn't compare line-for-line to see what was different. i hope i can be forgiven that neglect; i've been working 67 hours a week for over two months, and am right now working through the last 2.5 hours of my twelve hour shift today. so I'm going to just say "thank God it works, and thanks for reading and posting, George!", and go on to the next problem to be fixed. :) tina

the code that works:
CODE
Option Compare Database
Option Explicit

#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hWnd As LongPtr, _
   ByVal bRevert As Long) As Long
#Else
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
   ByVal bRevert As Long) As Long
#End If

#If VBA7 And Win64 Then
Private Declare PtrSafe Function EnableMenuItem Lib "user32" (ByVal hMenu As _
   Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
#Else
Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As _
   Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
#End If

#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetMenuItemInfo Lib "user32" Alias _
   "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal B As _
   Long, lpMenuItemInfo As MENUITEMINFO) As Long
#Else
Private Declare Function GetMenuItemInfo Lib "user32" Alias _
   "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal B As _
   Long, lpMenuItemInfo As MENUITEMINFO) As Long
#End If

Private Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wID As Long
    hSubMenu As Long
    hbmpChecked As Long
    hbmpUnchecked As Long
    dwItemData As Long
    dwTypeData As String
    cch As Long
End Type

Const MF_GRAYED = &H1&
Const MF_BYCOMMAND = &H0&
Const SC_CLOSE = &HF060&

Public Property Get Enabled() As Boolean
    Dim hWnd As Long
    Dim hMenu As Long
    Dim Result As Long
    Dim MI As MENUITEMINFO
    
    MI.cbSize = Len(MI)
    MI.dwTypeData = String(80, 0)
    MI.cch = Len(MI.dwTypeData)
    MI.fMask = MF_GRAYED
    MI.wID = SC_CLOSE
    hWnd = Application.hWndAccessApp
    hMenu = GetSystemMenu(hWnd, 0)
    Result = GetMenuItemInfo(hMenu, MI.wID, 0, MI)
    Enabled = (MI.fState And MF_GRAYED) = 0
End Property

Public Property Let Enabled(boolClose As Boolean)
    Dim hWnd As Long
    Dim wFlags As Long
    Dim hMenu As Long
    Dim Result As Long
    
    hWnd = Application.hWndAccessApp
    hMenu = GetSystemMenu(hWnd, 0)
    If Not boolClose Then
        wFlags = MF_BYCOMMAND Or MF_GRAYED
    Else
        wFlags = MF_BYCOMMAND And Not MF_GRAYED
    End If
    Result = EnableMenuItem(hMenu, SC_CLOSE, wFlags)
End Property

This post has been edited by tina t: Oct 5 2019, 08:57 PM

--------------------
"the wheel never stops turning"
Go to the top of the page
 
GroverParkGeorge
post Oct 5 2019, 09:30 PM
Post#4


UA Admin
Posts: 36,029
Joined: 20-June 02
From: Newcastle, WA


Congratulations on solving the problem.

Continued success with the project.

--------------------
My Real Name Is George. Grover Park Consulting is where I do business.
How to Ask a Good Question
Beginning SQL Server
Go to the top of the page
 
Phil_cattivocara...
post Oct 6 2019, 03:39 AM
Post#5



Posts: 368
Joined: 2-April 18



QUOTE (tina t)
...i didn't compare line-for-line to see what was different...
If we talk about the code you posted, the only difference is
CODE
'old
     Private Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _  '<=== Long!!!
   ...
     'new
Private Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hWnd As LongPtr, _ '<=== LongPtr!!!
     ...
I am not so expert with conditional compiling and Access (Office) 64bit but I see you always use
CODE
#If VBA7 And Win64 ...
I do now know if they are both necessary. Look at here
How to convert Windows API declarations in VBA for 64-bit

(sorry, PhilS. I know you are an UtterAccess' member and I use a link to your site for this)

--------------------
Please forgive in advance my horrible English.
Go to the top of the page
 
isladogs
post Oct 6 2019, 05:24 AM
Post#6


UtterAccess VIP
Posts: 1,793
Joined: 4-June 18
From: Somerset, UK


Following Phil C's comments, and just to be clear, as long as you use LongPtr (rather than LongLong) for handles/pointers such as hWnd, the conditional compilation should just be

CODE
#If VBA7 Then

#Else

#End if


Only rarely do you need to specify #If Win64 separately.

Of course if all users are running A2010 or later, you don't need conditional compilation at all.
Just use the part in the VBA7 section with PtrSafe and LongPtr

EDIT
You also need conditional compilation for the pointers in LetEnabled and GetEnabled
Though your code may compile, I'm fairly sure that part won't work correctly as it is currently written

--------------------
Colin (Mendip Data Systems)
Website, email
Go to the top of the page
 
tina t
post Oct 6 2019, 12:47 PM
Post#7



Posts: 6,150
Joined: 11-November 10
From: SoCal, USA


thank you, Phil and Colin! i'll work on these issues when i go back to the grind tomorrow. :) tina

--------------------
"the wheel never stops turning"
Go to the top of the page
 
ADezii
post Oct 6 2019, 05:57 PM
Post#8



Posts: 2,688
Joined: 4-February 07
From: USA, Florida, Delray Beach


Not sure if it is relevant, but isn't the 64-bit Type Declaration for MENUITEMINFO incorrect?
CODE
Type MENUITEMINFO
  cbSize As Long    
  fMask As Long    
  fType As Long    
  fState As Long    
  wID As Long    
  hSubMenu As LongPtr    
  hbmpChecked As LongPtr    
  hbmpUnchecked As LongPtr    
  dwItemData As LongPtr    
  dwTypeData As String    
  cch As Long    
  hbmpItem As LongPtr              
End Type
Go to the top of the page
 
tina t
post Oct 8 2019, 03:57 PM
Post#9



Posts: 6,150
Joined: 11-November 10
From: SoCal, USA


QUOTE
You also need conditional compilation for the pointers in LetEnabled and GetEnabled

colin, i have no idea how to tell what is a pointer, and what is something else. any instructions, links, etc, that might help me?

tia,
tina

--------------------
"the wheel never stops turning"
Go to the top of the page
 
tina t
post Oct 10 2019, 09:50 PM
Post#10



Posts: 6,150
Joined: 11-November 10
From: SoCal, USA


okay, folks, i found some info at

https://docs.microsoft.com/en-us/windows/win32/api/_menurc/

and made some changes, from what i could understand - probably not getting everything right. i didn't change the conditional

#If VBA7 And Win64 Then

but instead tried to get the LongPtr vs Long types right. i also changed the

Type MENUITEMINFO

data types to match ADezii's post.

anyway, what i came out with does compile, and does work in the test db. i've attached a copy - it's A2016 64-bit, but if anyone wants to look and critique (sp?), i'm all ears eyes.

tia,
tina

Attached File  __WindowsAPI_cleanup.zip ( 33.84K )Number of downloads: 2

--------------------
"the wheel never stops turning"
Go to the top of the page
 
isladogs
post Oct 10 2019, 11:17 PM
Post#11


UtterAccess VIP
Posts: 1,793
Joined: 4-June 18
From: Somerset, UK


Thanks for the link which was new to me
I haven't looked at your file but you only need conditional compilation if some users still run A2007 or earlier.
If so, just use
#If VBA7 Then...
rather than
#If VBA7 And Win64 Then...

I used to use over complex conditional compilation which I'm gradually changing as and when I review code.
This thread may be helpful https://www.access-programmers.co.UK/forums...ad.php?t=307222

Also recommend you read Phillip Stiefel's guide https://codekabinett.com/rdumps.php?Lang=2&...tion-vba-64-bit

--------------------
Colin (Mendip Data Systems)
Website, email
Go to the top of the page
 
cheekybuddha
post Oct 11 2019, 03:17 AM
Post#12


UtterAccess VIP
Posts: 11,675
Joined: 6-December 03
From: Telegraph Hill


@colin - more coffee? wink.gif

>> conditional formatting <<

Looks like you were burning the midnight oil!

--------------------


Regards,

David Marten
Go to the top of the page
 
isladogs
post Oct 11 2019, 03:22 AM
Post#13


UtterAccess VIP
Posts: 1,793
Joined: 4-June 18
From: Somerset, UK


Thanks David. Now corrected!
New puppy wanted to be let out at 4am and couldn't get back to sleep.
Still waiting for coffee....machine not working and can't think straight thumbdn.gif

--------------------
Colin (Mendip Data Systems)
Website, email
Go to the top of the page
 
moke123
post Oct 11 2019, 04:18 AM
Post#14



Posts: 1,368
Joined: 26-December 12
From: Berkshire Mtns.


Congrats on the New puppy!
Go to the top of the page
 
isladogs
post Oct 11 2019, 04:37 AM
Post#15


UtterAccess VIP
Posts: 1,793
Joined: 4-June 18
From: Somerset, UK


Cheers. Just like having a young child again ….
Isla, the 8 year old lab in the picture, isn't too impressed smirk.gif

--------------------
Colin (Mendip Data Systems)
Website, email
Go to the top of the page
 
cheekybuddha
post Oct 11 2019, 05:08 AM
Post#16


UtterAccess VIP
Posts: 11,675
Joined: 6-December 03
From: Telegraph Hill


Pictures please!

--------------------


Regards,

David Marten
Go to the top of the page
 
tina t
post Oct 11 2019, 02:38 PM
Post#17



Posts: 6,150
Joined: 11-November 10
From: SoCal, USA


thanks for the additional links, colin. and i'm with David - we want to see pics! smile.gif tina

--------------------
"the wheel never stops turning"
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    14th November 2019 - 04:39 AM