@ column list box

jpl458

Well-known member
Local time
Today, 08:11
Joined
Mar 30, 2012
Messages
1,218
I have a list box with 2 columns, Tool and URL based on the following file:

1661873181626.png


Design view for table is:

1661873963927.png



The entry for CorporateWiki, when double clicked returns this error;

1661873353064.png


The other entries in the list work as expected.

The code in the double click event is:

1661873522831.png

(Will rename listbox after it works)

In All property for list box:

Column count 2
Column Widths 1",0"

If I copy and past the CorporateWiKi url and load into browser, it works fine. Just not in the Listbox when double clicked.
Have rebuilt this several times.

Thanks
 
I get the GDPR crap for that site when trying in Chrome.
I do not for the others I tried? 1, 5 & 6
 
I get the GDPR crap for that site when trying in Chrome.
I do not for the others I tried? 1, 5 & 6
I don't understand your reply
 
The entry for CorporateWiki, when double clicked returns this error;
Try:
Code:
Private Sub List64_DblClick(Cancel As Integer)
Dim sVal As String
    sVal = Me.List64.Column(2) & ""
    Debug.Print sVal
    MsgBox sVal, vbInformation
    
    'Application.FollowHyperlink sVal
End Sub

What will happen?
 
I don't understand your reply
I get the GDPR window for that site only. That interferes with access to the actual URL until you answer the questions.
WHat annoys me with these is that if you select 'Save cookies' and nothing else, it still asks you the same crap the next time you visit a site. :mad:
 
when double clicked returns this error;
Try other way to open Hyperlink:
Code:
    WScriptFollowHyperlink sURL

Using that Procedure:
Code:
Public Sub WScriptFollowHyperlink(vLink)
' FollowHyperlink is not working properly !!!
'----------------------------------------------------------------------------------------------
Dim wsShell As Object
Dim sVal As String
On Error GoTo WScriptFollowHyperlink_Err
 
    sVal = vLink & ""
    If Len(sVal) & "" < 5 Then Exit Sub

     sVal = Chr(34) & sVal & Chr(34)
    Set wsShell = CreateObject("WScript.Shell")
    wsShell.Run sVal

WScriptFollowHyperlink_End:
    On Error Resume Next
    Set wsShell = Nothing
    Err.Clear
    Exit Sub

WScriptFollowHyperlink_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub" & _
           "WScriptFollowHyperlink.", vbCritical, "Error!"
    'Debug.Print "WScriptFollowHyperlink_Line: " & Erl & "."
    Err.Clear
    Resume WScriptFollowHyperlink_End
End Sub
 
I don't understand your reply

Try other way to open Hyperlink:
Code:
    WScriptFollowHyperlink sURL

Using that Procedure:
Code:
Public Sub WScriptFollowHyperlink(vLink)
' FollowHyperlink is not working properly !!!
'----------------------------------------------------------------------------------------------
Dim wsShell As Object
Dim sVal As String
On Error GoTo WScriptFollowHyperlink_Err

    sVal = vLink & ""
    If Len(sVal) & "" < 5 Then Exit Sub

     sVal = Chr(34) & sVal & Chr(34)
    Set wsShell = CreateObject("WScript.Shell")
    wsShell.Run sVal

WScriptFollowHyperlink_End:
    On Error Resume Next
    Set wsShell = Nothing
    Err.Clear
    Exit Sub

WScriptFollowHyperlink_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub" & _
           "WScriptFollowHyperlink.", vbCritical, "Error!"
    'Debug.Print "WScriptFollowHyperlink_Line: " & Erl & "."
    Err.Clear
    Resume WScriptFollowHyperlink_End
End Sub
Using a listbox is much easier, I just want to know why one URL will not run from the listbox when double clicked
 
I just want to know why one URL will not run from the listbox when double clicked
Have you read my post #4?
...
I suggested that instead of
Code:
    Application.FollowHyperlink sVal
to use Procedure from post #6
Code:
WScriptFollowHyperlink sVal
 
(Will rename listbox after it works)
Why would you deliberately make work for yourself? You do realize don't you that when you rename the control, you orphan all the code. Now you have to find it, delete it from the old event. Delete the old event and paste it into the new event. And then you need to compile and find all the other errors and fix them.

Coding is so much easier if you take just a smidgen of time to do it right the first time. Then you don't have to fix it later:)
 
Well, if you rename the listbox, you can correct the event name in VBA and it will associate with the control. However, all code referencing the old name will also have to be edited. Name your controls first then build code.

Work for me with Edge. Opens to a page requiring entry of company name to search:
 
Last edited:
Try:
Code:
Private Sub List64_DblClick(Cancel As Integer)
Dim sVal As String
    sVal = Me.List64.Column(2) & ""
    Debug.Print sVal
    MsgBox sVal, vbInformation
   
    'Application.FollowHyperlink sVal
End Sub

What will happen?
I tried your code and singled stepped through it with F8. I inserted it as is just to see how it worked. The Debug.Print sVal printed nothing. And, should the Application.FollowHyperlink sVal actually open the URL? I tried it and it didn't. Not being critical, just have lack of knowledge.
Thanks
 
works with chrome with

Code:
'************ Code Start **********
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
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


'***App Window Constants***
Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 3            'Open Maximized
Public Const WIN_MIN = 2            'Open Minimized


'***Error Codes***
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&


'***************Usage Examples***********************
'Open a folder:     ?fHandleFile("C:\TEMP\",WIN_NORMAL)
'Call Email app:    ?fHandleFile("mailto:dash10@hotmail.com",WIN_NORMAL)
'Open URL:          ?fHandleFile("http://home.att.net/~dashish", WIN_NORMAL)
'Handle Unknown extensions (call Open With Dialog):
'                   ?fHandleFile("C:\TEMP\TestThis",Win_Normal)
'Start Access instance:
'                   ?fHandleFile("I:\mdbs\CodeNStuff.mdb", Win_NORMAL)
'****************************************************


Function fHandleFile(stFile As String, lShowHow As Long)
    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)
End Function
'************ Code End **********

call it like

Code:
fHandleFile Me.List23, 1
 
Not sure if this helps, but I just tried it two different ways in the Immediate Window like so:
1661894780038.png

and both times, it gave me this.
1661894795468.png
 
And I just tried it from a Listbox DblClick event, and it still worked! :unsure:
 
Not sure if this helps, but I just tried it two different ways in the Immediate Window like so:
View attachment 102903
and both times, it gave me this.
View attachment 102904
I canget it to work by pasting the url into Chrome. Just can't get it to work out of a list box. Seems like it works everywhere else except a list box. The other entries in the listbox work, except for the CorporateWicki.
 
It works for me from listbox with Edge and Chrome. Time to provide your db for analysis? Follow instructions at bottom of my post.
 
Last edited:
I tried your code and singled stepped through it with F8. I inserted it as is just to see how it worked. The Debug.Print sVal printed nothing. And, should the Application.FollowHyperlink sVal actually open the URL? I tried it and it didn't. Not being critical, just have lack of knowledge.
Thanks
There is a typo there.
If only 2 columns then as they start at 0 index, you need (1) not (2)?

As it appears to work for everyone but you, have you got any hidden characters in the entry?
Which one anyway, as you have two in there? :(
 

Users who are viewing this thread

Back
Top Bottom