Author: Dick Kusleika

IsIn Collection or Array

Posted on by Dick Kusleika

Created by Bill Manville:
Checks whether a name exists in a collection.
For example, If IsIn(ActiveWorkbook.Names, “ThisOne”) Then …

Function IsIn(oCollection As Object, stName As String) As Boolean
    Dim O As Object
    On Error GoTo NotIn
    Set O = oCollection(stName)
    IsIn = True   ‘succeeded in creating a pointer to the object so
                  ‘must be there
NotIn:
 
End Function

Editor’s Note:

Another way:

Function IsInCol(oCollection As Object, stName As String) As Boolean
 
    On Error Resume Next
    IsInCol = Not oCollection(stName) Is Nothing
   
End Function

Tushar posted a similar function earlier on the newsgroups, but for arrays instead of collections. Nice use of the Join function.

Function IsInArr(ByVal StringSetElementsAsArray As Variant, _
    ByVal sName As String) As Boolean
 
    On Error Resume Next
    IsInArr = InStr(1, _
        Chr$(0) & Join(StringSetElementsAsArray, Chr$(0)) & Chr$(0), _
        Chr$(0) & sName & Chr$(0), _
        vbTextCompare) > 0
 
End Function

Another way:

Function IsInArr2(ByVal StringSetElementsAsArray As Variant, _
    ByVal sName As String) As Boolean
   
    On Error Resume Next
    IsInArr2 = Not IsError(Application.Match(sName, StringSetElementsAsArray, False))
   
End Function

Get Outlook’s Currently Selected Time

Posted on by Dick Kusleika

I got an email from Dennis, a blind computer user (visually impaired as a bat, as he puts it). He uses a screen reading program that includes a scripting language. This language gives him access to the object models so he can get whatever information he needs.

What he needs to know is which day/time is selected when a user is looking at the calendar. That seems like it would be pretty easy, but you may be surprised. I went through every property and method of the ActiveExplorer object and could get there. Next I thought that I could create a new AppointmentItem and read where it defaulted the Start property. When I created a new AppointmentItem using

Application.CreateItem(olAppointmentItem)

It defaulted to the current time, not the selected time. Drat.

Next, I discovered that selecting Actions > New Appointment would create an appointment with the proper Start default. The only problem was that I could find that commandbarcontrol. I looped through every commandbar and every control and simply could not locate it. I know it’s there.

Finally, I went with the old standby: SendKeys. This code produced a message box with the currently selected time. I’m sure it’s fraught with danger, but it’s the best I could do.

Sub GetCurrentDay()

    Dim dtSelected As Date
    Dim i As Long
   
    If Application.ActiveExplorer.CurrentFolder.DefaultItemType = olAppointmentItem Then
        SendKeys “^+A”
        For i = 1 To 10000: DoEvents: Next i
        dtSelected = Application.ActiveInspector.CurrentItem.Start
        Application.ActiveInspector.Close olDiscard
        MsgBox Format(dtSelected, “mm/dd/yyyy hh:mm”)
    End If
   
End Sub

By the way, this is still an Excel blog, but this particular piece of code goes in Outlook.

G’Day Excel Thoughts

Posted on by Dick Kusleika

When he’s not throwing more shrimp on the barbie (or deflecting stupid comments like that), Andrew is writing his Excel blog.

Excel Thoughts

He’s only got two posts up so far, but if you start reading now you can say “Oh, I’ve been reading Andrew Roberts from the beginning” when he’s famous.

Update: Andrew, I can’t find an RSS feed on your blog. If it’s there, tell me how to get to it and if it’s not, get one immediately. Okay, not immediately, but let me know when you have one so I can the feed to my daily Bloglines reads.

Hungarian Notation

Posted on by Dick Kusleika

I like to read Joel on Software. I don’t know if he’s smart, but I know he’s smarter than me. Recently, I enjoyed reading Making Wrong Code Look Wrong. I’ve long disliked hungarian notation, or what I now know as Systems Hungarian. The reason that I dislike it is because it doesn’t serve any purpose to me, almost. I know that Fname is a file name and thus a string. sFname doesn’t help. I know that Idx is and counter in a loop and thus a long integer. lIdx doesn’t help.

All my code, both the code I publish here and the code I don’t, uses Systems Hungarian. Why? I don’t know, but I suspect it’s a combination of a lack of a better alternative and my conformist personality. It costs me virtually nothing to use sFname instead of just Fname, and if it helps just one person understand the code more easily, then it’s worth it. However, if there was a better way, I think I would latch on to it, so long as I could understand it.

I was writing a function for the Tenth Hole Tracker and I started with the key field of the Players table being a string, namely the players’ names. After some soul searching, I changed the key field to a meaningless autonumber (a long integer). While I was building my WHERE clauses, I used variables like

WHERE Player='” & sPlayer & “‘”

Now I had to change all the code to something like

WHERE Player=” & lPlayer

It was quite helpful to have the ‘s’ in front to remind me to remove the single quotes. If the variable had been simply Player, then I wouldn’t have had that visual clue that I needed or didn’t need to enclose it in quotes. Had it been one function, it may not have been a big deal. By the time I had my epiphany, I had no less than seven functions that needed to be changed. (I shouldn’t be builing so many SQL statements, probably, but I’ll save that for another confession post.

There is, what I consider to be, a good example of why Systems Hungarian is a good system. Knowing that my variable had to match the data type in the database, it was useful to have the data type prefix. Joel gives a pretty good example of Apps Hungarian with his signed v. unsigned strings. I get the example, but I’ve never seen it in practice. Maybe my apps aren’t complicated enough to warrant a different notation system.

Okay, enough of my drunken ramblings. The whole reason for this post is to hear what you do. Are you a strict Hungarian Notator? Have you ever used a system that wasn’t data type based? Do you sometimes deviate and in what situations? Discuss.

ShellDelete

Posted on by Dick Kusleika

Created by Jim Rech:
Removes a known directory including all of its files and any/all
possible sub-directories of unknown quantity & name/s including their
files.

Const FO_DELETE = &h3&
Const FOF_NOCONFIRMATION = &h10&
 
Private Type SHFILEOPSTRUCT
   hwnd As Long
   wFunc As Long
   pFrom As String
   pTo As String
   fFlags As Integer
   fAnyOperationsAborted As Long
   hNameMappings As Long
   lpszProgressTitle As String
End Type
 
Private Declare Sub CopyMemory Lib “KERNEL32” Alias “RtlMoveMemory”
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
 
Private Declare Function SHFileOperation Lib “Shell32.dll” Alias
“SHFileOperationA” (lpFileOp As Any) As Long
 
Sub Test()
    ShellDelete “c:aaa”
End Sub
 
Sub ShellDelete(SrcFile As String)
    Dim result As Long
    Dim lenFileop As Long
    Dim foBuf() As Integer
    Dim fileop As SHFILEOPSTRUCT
    lenFileop = LenB(fileop)
    ReDim foBuf(1 To lenFileop)
    With fileop
        .hwnd = 0
       .wFunc = FO_DELETE
       .pFrom = SrcFile & Chr(0) & Chr(0)
        .fFlags = FOF_NOCONFIRMATION
        .lpszProgressTitle = “” & Chr(0) & Chr(0)
    End With
    Call CopyMemory(foBuf(1), fileop, lenFileop)
    Call CopyMemory(foBuf(19), foBuf(21), 12)
    result = SHFileOperation(foBuf(1))
End Sub

Editor’s note: Tested and it works, but I still don’t get it. I’m going to print it out and put it under my pillow for a couple of nights and see if that helps. In the mean time, you can leave a comment explaining it to me.

Directory Exists

Posted on by Dick Kusleika

Created by Rob Bovey:
Uses path as argument and it returns True if the
path is empty or doesn’t exist and False if the path contains files.

Function bIsEmpty(ByVal szPath As String) As Boolean
    Dim bReturn As Boolean
    Dim szTemp As String
    bReturn = True
    If Right$(szPath, 1) <> “” Then szPath = szPath & “”
    szTemp = Dir$(szPath & “*.*”)
    If szTemp <> “” Then bReturn = False
    bIsEmpty = bReturn
End Function

Editor’s note: I guess I never realized that Dir was string function. Jake pointed out in String Function Efficiency that I should use the dollar sign, and by gosh I’ve really tried. Now I’ll have to beat it into my head to use it with Dir too.

Single List Combobox Filtering

Posted on by Dick Kusleika

In Conditional Data Validation and Basing One Listbox on Another, I showed how to based one “control” on another using multiple list. Gerry in the newsgroups wants to do the same thing, but filtering only one list.

I start with a list named NameList showing surname, first name, and date of birth and two comboboxes (cbxSurname and cbxFirstname) and one textbox (tbxDOB).

excel range showing comboboxes, textbox and list data

When the workbook opens, cbxSurname is filled with all the unique surnames in the list.

Private Sub Workbook_Open()
   
    Dim rCell As Range
    Dim rRng As Range
    Dim colUniques As Collection
    Dim vItm As Variant
   
    ‘initialize range and collection
    Set rRng = Sheet1.Range(“NameList”).Columns(1)
    Set colUniques = New Collection
   
    ‘clear the combobox in case we need to call this some
    ‘other time
    Sheet1.cbxSurname.Clear
   
    ‘loop through the cells adding them to a collection
    ‘duplicate keys won’t be added
    For Each rCell In rRng.Cells
        On Error Resume Next
            colUniques.Add rCell.Value, rCell.Value
        On Error GoTo 0
    Next rCell
   
    ‘loop through the collection and add to the combobox
    For Each vItm In colUniques
        Sheet1.cbxSurname.AddItem vItm
    Next vItm
   
End Sub

When a surname is selected from cbxSurname, the Change event is fired and cbxFirstname is loaded with matching first names.

Private Sub cbxSurname_Change()

    Dim rFound As Range
    Dim rRng As Range
    Dim sFirstAdd As String
   
    Me.tbxDOB.Text = “”
    Set rRng = Me.Range(“NameList”).Columns(1)
   
    With Me.cbxFirstname
        .Clear
       
        Set rFound = rRng.Find(Me.cbxSurname.Text)
       
        If Not rFound Is Nothing Then
            sFirstAdd = rFound.Address
           
            Do
                .AddItem rFound.Offset(0, 1).Value
                Set rFound = rRng.FindNext(rFound)
            Loop Until rFound.Address = sFirstAdd
        End If
    End With
   
End Sub

Finally, when a first name is selected, the date of birth is put into the textbox.

Private Sub cbxFirstname_Change()
   
    Dim rFound As Range
    Dim rRng As Range
    Dim sFirstAdd As String
   
    Me.tbxDOB.Text = “”
    Set rRng = Me.Range(“NameList”).Columns(1)
   
    Set rFound = rRng.Find(Me.cbxSurname.Text)
   
    If Not rFound Is Nothing Then
        sFirstAdd = rFound.Address
        Do
            If rFound.Offset(0, 1).Value = Me.cbxFirstname.Text Then
                Me.tbxDOB.Text = Format(rFound.Offset(0, 2).Value, “mm/dd/yyyy”)
            Else
                Set rFound = rRng.FindNext(rFound)
            End If
        Loop Until rFound.Address = sFirstAdd Or Len(Me.tbxDOB.Text) > 0
    End If
   
End Sub