Avatar of Daniel Pineault
Daniel Pineault

asked on 

How to change the cursor?

I'm needing to change the cursor in Outlook while a proc is running.

In Office x32 I use, and it works.

Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare Function SetSystemCursor Lib "user32" (ByVal hcur As Long, ByVal id As Long) As Long
Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Const OCR_NORMAL = 32512
Private Const IDC_WAIT = 32514&

Sub CursorWait()
    Dim hCursor               As Long

    On Error GoTo Error_Handler

    hCursor = LoadCursor(ByVal 0&, IDC_WAIT)
    SetSystemCursor hCursor, OCR_NORMAL
    DestroyCursor hCursor

Error_Handler_Exit:
    On Error Resume Next
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: CursorWait" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

Sub CursorNormal()
    Dim hCursor               As Long

    On Error GoTo Error_Handler

    hCursor = LoadCursor(ByVal 0&, OCR_NORMAL)
    SetSystemCursor hCursor, IDC_WAIT
    DestroyCursor hCursor

Error_Handler_Exit:
    On Error Resume Next
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: CursorNormal" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

Open in new window


However, when I try to port it over to x64, nothing.  No error, but no change in cursor either.

Public Declare PtrSafe Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As LongPtr, ByVal lpCursorName As String) As LongPtr
Private Declare PtrSafe Function SetSystemCursor Lib "user32" (ByVal HCur As LongPtr, ByVal id As Long) As Long
Private Declare PtrSafe Function DestroyCursor Lib "user32" (ByVal hCursor As LongPtr) As Long
Private Const OCR_NORMAL = 32512
Private Const IDC_WAIT = 32514&

Sub CursorWait()
    Dim hCursor               As LongPtr

    On Error GoTo Error_Handler

    hCursor = LoadCursor(ByVal 0&, IDC_WAIT)
    SetSystemCursor hCursor, OCR_NORMAL 
    DestroyCursor hCursor

Error_Handler_Exit:
    On Error Resume Next
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: CursorWait" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

Sub CursorNormal()
    Dim hCursor               As LongPtr

    On Error GoTo Error_Handler

    hCursor = LoadCursor(ByVal 0&, OCR_NORMAL)
    SetSystemCursor hCursor, IDC_WAIT
    DestroyCursor hCursor

Error_Handler_Exit:
    On Error Resume Next
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: CursorNormal" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

Open in new window


When checking I notice that LoadCursor is returning 0^ instead of a proper value.  What am I doing wrong, or what approach would universally work?
Microsoft OfficeOutlookMicrosoft 365VBA

Avatar of undefined
Last Comment
Daniel Pineault
Avatar of ste5an
ste5an
Flag of Germany image

It's a typo in your declaration.. you've declared lpCursorName incorrectly as string in your 64-bit version.

No, that is the call (unless the docs are wrong).   Looked at the same thing myself.  Doesn't seem right, but that's what the docs state.


Jim.

ASKER CERTIFIED SOLUTION
Avatar of Bill Prew
Bill Prew

Blurred text
THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
Avatar of ste5an
ste5an
Flag of Germany image

Yup, cause that parameter expects a MAKEINTRESOURCE value (number -> word -> long ptr -> lpstr), which is not the same as a Long to String conversion in VBA..
Avatar of Daniel Pineault
Daniel Pineault

ASKER

I should have caught that one 32-bit Long, 64-bit String?!  Thank you all for your assistance.

<< I should have caught that one 32-bit Long, 64-bit String?!  Thank you all for your assistance.>>


 I caught this when I first looked at it, but the Office 2010 API docs do have it as a string and the on-line docs have it as an lpstr.


 Thought it was weird but I didn't have 64 bit here to check it out with.


Jim.

Avatar of Daniel Pineault

ASKER

Yes, that the doc. I used.  I've since reported the issue.  Hopefully MS will update the doc to save others this frustration.

Outlook
Outlook

Microsoft Outlook is a personal information manager from Microsoft, available as a part of the Microsoft Office suite. Although often used mainly as an email application, it also includes a calendar, task manager, contact manager, note-taker, journal, and web browser.

105K
Questions
--
Followers
--
Top Experts
Get a personalized solution from industry experts
Ask the experts
Read over 600 more reviews

TRUSTED BY

IBM logoIntel logoMicrosoft logoUbisoft logoSAP logo
Qualcomm logoCitrix Systems logoWorkday logoErnst & Young logo
High performer badgeUsers love us badge
LinkedIn logoFacebook logoX logoInstagram logoTikTok logoYouTube logo