Unanswered old post: Excel custom icon lost with multiple workbooks

Question

I can use the following code to set a custom icon for the Excel application. This will change the icon of the window, and the icon displayed in the Windows taskbar:

Public Const strIcon As String = "%SystemRoot%\system32\SHELL32.dll" ' Icon file
Public Const IconIndex As Long = 137

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal ClassName As String, ByVal WindowName As String) As Long
Public Declare Function SendMessageA Lib "user32" (ByVal HWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Public Declare Function ExtractIconA Lib "shell32.dll" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Public Const ICON_SMALL As Long = 0&
Public Const ICON_BIG As Long = 1&
Public Const WM_SETICON As Long = &H80



Sub SetupIcon()
    SetIcon strIcon, IconIndex
End Sub

Sub SetIcon(FileName As String, Optional index As Long = 0)
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' SetIcon
    ' This procedure sets the icon in the upper left corner of
    ' the main Excel window. FileName is the name of the file
    ' containing the icon. It may be an .ico file, an .exe file,
    ' or a .dll file. If it is an .ico file, Index must be 0
    ' or omitted. If it is an .exe or .dll file, Index is the
    ' 0-based index to the icon resource.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    #If VBA7 And Win64 Then
        ' 64 bit Excel
        Dim HWnd As LongPtr
        Dim HIcon As LongPtr
    #Else
        ' 32 bit Excel
        Dim HWnd As Long
        Dim HIcon As Long
    #End If
    Dim n As Long
    Dim s As String
    If Dir(FileName, vbNormal) = vbNullString Then
        ' file not found, get out
        Exit Sub
    End If
    ' get the extension of the file.
    n = InStrRev(FileName, ".")
    s = LCase(Mid(FileName, n + 1))
    ' ensure we have a valid file type
    Select Case s
        Case "exe", "ico", "dll"
            ' OK
        Case Else
            ' invalid file type
            Err.Raise 5
    End Select
    HWnd = Application.HWnd
    If HWnd = 0 Then
        Exit Sub
    End If
    HIcon = ExtractIconA(0, FileName, index)
    If HIcon <> 0 Then
        SendMessageA HWnd, WM_SETICON, ICON_SMALL, HIcon
    End If
End Sub

What I notice, however, is that if a new workbook is added to the application then the custom icon is lost (at least, in the taskbar) - and it reverts to the default Excel icon.

Searching online for a solution, I found a similar question asked on SO: Changing Excel Icon doesn't work when another workbook is opened

Naturally I would not normally post a new question which is an exact duplicate of an existing question. However no (ready) solution has been offered to that linked question. I also note that the question was posted in 2012, and therefore it is highly likely that since that time our community has grown in expertise and experience. They may well be someone out here now, who knows how to solve it but has simply not seen the question. I hope the community will forgive the duplicate question (think of it as bumping the old one).

Would anyone be able to offer a solution to this? My API knowledge is almost zero. Thanks.

Answer 1

When you start Excel it uses an application icon .

It uses it until you create any workbook beside the one initially created by Excel. Then it explodes workbooks on a taskbar and you get two buttons with a workbook icons .

Even if you close second workbook, the first still uses a workbook icon. When you close all workbooks, it will revert to the application icon (you can check it by calling your SetupIcon and closing all workbooks), but after creating any workbook it switches back to the workbook icon.

You should try to enumerate all workbook windows and change icons also for them.

I'm not sure if this can be done directly in VBA, but you could use winapi functions FindWindowEx, EnumChildWindows, GetWindow.

Main Excel window has class name XLMAIN. It contains XLDESK which contains workbooks (EXCEL7) and other children. Use Spy++ to inspect hierarchy.

This behavior probably depends on taskbar settings and available space. If taskbar doesn't explode buttons it will show application icon.

---

Checked it and unfortunatelly it doesn't work. It changes icons of workbook windows (when not maximized), but icons on taskbar stay te same.

---

This works, but it is a little hackish. I'm using hardcoded class name MS-SDIb. This is implementation detail of Excel 2007 and may not work in other versions.

'Doesn't work for me
'Public Const strIcon As String = "%SystemRoot%\system32\SHELL32.dll" ' Icon file
Public Const strIcon As String = "C:\Windows\system32\SHELL32.dll" ' Icon file

Public Const IconIndex As Long = 137

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal ClassName As String, ByVal WindowName As String) As Long
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClassName As String, ByVal lpszCaption As String) As Long
' For 64 bit may need replacing with SetClassLongPtr
Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Const GCL_HICON As Long = -14
Const GCL_HICONSM As Long = -34
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

Public Declare Function SendMessageA Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Public Declare Function ExtractIconA Lib "shell32.dll" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Public Const ICON_SMALL As Long = 0&
Public Const ICON_BIG As Long = 1&
Public Const WM_SETICON As Long = &H80


Sub SetupIcon()
    SetIcon strIcon, IconIndex
End Sub

Sub SetIcon(FileName As String, Optional index As Long = 0)
    #If VBA7 And Win64 Then
        ' 64 bit Excel
        Dim hwnd As LongPtr
        Dim DeskHWnd As LongPtr
        Dim Workbook As LongPtr
        Dim HIcon As LongPtr
    #Else
        ' 32 bit Excel
        Dim hwnd As Long
        Dim DeskHWnd As Long
        Dim Workbook As Long
        Dim HIcon As Long
    #End If
    Dim ThreadId As Long
    Dim n As Long
    Dim s As String
    If Dir(FileName, vbNormal) = vbNullString Then
        ' file not found, get out
        Exit Sub
    End If
    ' get the extension of the file.
    n = InStrRev(FileName, ".")
    s = LCase(Mid(FileName, n + 1))
    ' ensure we have a valid file type
    Select Case s
        Case "exe", "ico", "dll"
            ' OK
        Case Else
            ' invalid file type
            Err.Raise 5
    End Select
    hwnd = Application.hwnd
    If hwnd = 0 Then
        Exit Sub
    End If
    ThreadId = GetWindowThreadProcessId(hwnd, ByVal 0&)
    DeskHWnd = FindWindowEx(hwnd, 0, "XLDESK", vbNullString)
    If DeskHWnd = 0 Then
        Exit Sub
    End If

    HIcon = ExtractIconA(0, FileName, index)
    If HIcon = 0 Then
        Exit Sub
    End If

    SendMessageA hwnd, WM_SETICON, ICON_SMALL, HIcon
    SendMessageA hwnd, WM_SETICON, ICON_BIG, HIcon
    ' For 64 bit may need replacing with SetClassLongPtr
    SetClassLong hwnd, GCL_HICON, HIcon
    SetClassLong hwnd, GCL_HICONSM, HIcon

    WorkbookHWnd = FindWindowEx(DeskHWnd, 0, "EXCEL7", vbNullString)
    Do While WorkbookHWnd <> 0
        SendMessageA WorkbookHWnd, WM_SETICON, ICON_SMALL, HIcon
        SendMessageA WorkbookHWnd, WM_SETICON, ICON_BIG, HIcon

        WorkbookHWnd = FindWindowEx(DeskHWnd, WorkbookHWnd, "EXCEL7", vbNullString)
    Loop
    SetClassLong WorkbookHWnd, GCL_HICON, HIcon
    SetClassLong WorkbookHWnd, GCL_HICONSM, HIcon

    WorkbookHWnd = FindWindowEx(0, 0, "MS-SDIb", vbNullString)
    Do While WorkbookHWnd <> 0
        ' Check if WorkbookHWnd was created by same thread as Application.hwnd
        If ThreadId = GetWindowThreadProcessId(WorkbookHWnd, ByVal 0&) Then
            SendMessageA WorkbookHWnd, WM_SETICON, ICON_SMALL, HIcon
            SendMessageA WorkbookHWnd, WM_SETICON, ICON_BIG, HIcon
            SetClassLong WorkbookHWnd, GCL_HICON, HIcon
            SetClassLong WorkbookHWnd, GCL_HICONSM, HIcon
        End If

        WorkbookHWnd = FindWindowEx(0, WorkbookHWnd, "MS-SDIb", vbNullString)
    Loop
End Sub

Works even for new workbooks thanks to changing class icon with SetClassLong.

BUG: Each call leaks icon returned by ExtractIconA.