text box ?

[Navarone]

It's been a few years since I did any VB6 programming and my question is can I have a clickable mailto:[email protected] in a text box that is dynamically driven?

Here is an example of some code the previous VB programmer did and I will need to make some updates.

Many thanks in advance.

'/////////////////// DROP DOWNS FOR DEMOGRAPHICS ANCHOR TENTANTS ////////////////////
Sub writeAnchorTenantsDisplay(ByRef objText As TextBox, sCenterId As String)

 
   Call CreateConnection
   Dim sReturn As String
      
   '////// THIS GETS THE HOUSEHOLD INFO
   Set objRs = New ADODB.Recordset
   objRs.ActiveConnection = objConn
   objRs.CursorLocation = adUseClient
   objRs.CursorType = adOpenForwardOnly
   objRs.LockType = adLockReadOnly
   objRs.Source = "select tenant_list.tenant,tenants.area from TENANTS inner join tenant_list on tenants.center_tenant_id=tenant_list.tenant_id where tenants.Center_Id = " & sCenterId & " Order by tenants.narea DESC"
   'MsgBox objRs.Source
   objRs.Open
   
   sReturn = ""
   sGAnchorTenants = ""
   If objRs.EOF Then
      'HANDLE THE ERROR
      'objText.Text = "No records found!"
   Else
      Do While Not objRs.EOF()
      
         sGAnchorTenants = sGAnchorTenants & sReturn & objRs.Fields!tenant & " - " & objRs.Fields!area & " sq. ft."
         sReturn = vbCrLf
      
         objText.Text = objText.Text & objRs.Fields!tenant & " - " & objRs.Fields!area & " sq. ft." & vbCrLf
         
         objRs.MoveNext
      
      Loop
   
   End If


   objRs.Close
   Set objRs = Nothing
   Call CloseConnection
   
End Sub

[longwolf]

You could use the textbox's click or double click event.
Check it's SelStart location, parse the 'word' that it's in.

Test that 'word' (whatever is between to spaces, etc), if it''s an email address, call your email code.

[Navarone]

I don't understand what you said could you show me please? What if there was more than one email address?

[dee-u]

This maybe what you are looking for...

[longwolf]

This maybe what you are looking for...

Nice control!

In case Navarone needs to use a textbox, here's some 'quicky' code I wrote.
It's very rough but should work in most cases.

And it will only handle whatever 'word' the user double clicks on.

Private Sub txtBox_DblClick()
    Dim sWord As String
    
    sWord = ParseWord(txtBox)
Debug.Print Chr$(34) & sWord & Chr$(34), IsEmailAddress(sWord)
End Sub

Public Function ParseWord(ByRef txtX As TextBox) As String
'Not perfect, but does a pretty good job
    Dim sWord As String
    Dim sOut As String
    Dim sBreak() As String
    Dim lX As Long
    
    sWord = Mid$(txtX.Text, txtX.SelStart + 1, txtX.SelLength)
    If Len(sWord) = 0 Then Exit Function
    If Right$(sWord, 1) = "." Then
'        If txtX.SelStart + txtX.SelLength = Len(txtX.Text) Then
            sWord = Left$(sWord, Len(sWord) - 1)
'        End If
    End If
    sOut = "., |.,^|, |,^|. |.^|; |;^"
    sOut = Replace$(sOut, "^", vbCr)
    sBreak = Split(sOut, "|")
    For lX = 0 To UBound(sBreak)
        sWord = Replace$(sWord, sBreak(lX), vbNullString)
    Next
    ParseWord = Trim$(sWord)
End Function

Public Function IsEmailAddress(ByRef sWord As String) As Boolean
'this could be a lot better, but will work for most
    Dim lAt As Long
    Dim lDot As Long
    
    lAt = InStr(sWord, "@")
    lDot = InStrRev(sWord, ".")
    If lAt > 1 Then
        If lDot > lAt + 1 Then
            'could be an address
            IsEmailAddress = True
        End If
    End If
End Function

[longwolf]

Improved the ParseWord function

Public Function ParseWord(ByRef txtX As TextBox) As String
'Not perfect, but does a pretty good job
    Dim sWord As String
    Dim sOut As String
    Dim sBreak() As String
    Dim lX As Long
    
    sWord = Mid$(txtX.Text, txtX.SelStart + 1, txtX.SelLength)
    If Len(sWord) = 0 Then Exit Function
    sWord = Trim$(sWord)
    sOut = ".,|,|.|;"
    sBreak = Split(sOut, "|")
    For lX = 0 To UBound(sBreak)
        If Right$(sWord, Len(sBreak(lX))) = sBreak(lX) Then
            sWord = Left$(sWord, Len(sWord) - Len(sBreak(lX)))
        End If
    Next
    ParseWord = Trim$(sWord)
End Function

[Navarone]

Thanks for the exampls everyone. Like I say, it's been a while since I did any VB coding. The text box is going to be populated from fields in a database. I will probably stay with the text box for now rather then to introduce a new control.

Using code similar to my first post longwolf, will your parseword function work? It is basicly reading thru the text box looking for anything like an email address correct?

[longwolf]

longwolf, will your parseword function work?

Yes

It is basicly reading thru the text box looking for anything like an email address correct?

Not exactly.
It doesn't read the whole text, it works like this...
When a user double clicks a 'word' in the textbox that 'word' automatically highlights.

We're trapping that textbox's double click event and sending the textbox to ParseWord.

ParseWord separates the highlighted text from the rest of the text in the box, cleans it up and returns the clicked on 'word'

You can then send the 'word' to the IsEmailAddress function.
It checks for the basic features of an email address and returns True or False.

Let's say your textbox has the following string in it:
"You can contact me at [email protected];
or you can reach our sale team at [email protected]."

If the user double clicks the word "contact ", ParseWord will trim the trailing space and return "contact" which gets stored in the variable sWord.
IsEmailAddress will look at sWord and return False.

But if they double clicks one of the addresses, it will remove the trailing punctuation and IsEmailAddress will return True.

This only handles one 'word' at a time, whatever was clicked on.