Обновление рабочего стола

Option Explicit
 
Private Const SHCNE_ASSOCCHANGED As Long = &H8000000
Private Const SHCNF_IDLIST As Long = &H0
 
Private Declare Function SHChangeNotify Lib "Shell32.dll" (ByVal wEventID As Long, _
ByVal uFlags As Long, ByVal dwItem1 As Long, ByVal dwItem2 As Long) As Long
 
Private Sub Command1_Click()
' обновить рабочий стол
Call SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0)
 
End Sub

Option Explicit
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
Private Sub Command1_Click()
Dim Des As Long
Des = FindWindow("Progman", "Program Manager")
SetForegroundWindow (Des)
SendKeys "{F5}"
End Sub

' Обновить кеш иконок
Public Sub RefreshLNK()
    On Error GoTo ErrorHandler
    
    SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_FLUSH, 0&, 0&
    
    Const CLSIDSTR_ActiveDesktop As String = "{75048700-EF1F-11D0-9888-006097DEACF9}"
    
    Dim CLSID_ActiveDesktop As UUID
    Dim IID_IUnknown        As UUID
    Dim oUnknown            As IUnknown
    Dim oActiveDesktop      As IActiveDesktop
    
    CLSIDFromString StrPtr(CLSIDSTR_ActiveDesktop), CLSID_ActiveDesktop
    CLSIDFromString StrPtr(IIDSTR_IUnknown), IID_IUnknown
    
    If S_OK = CoCreateInstance(CLSID_ActiveDesktop, 0&, CLSCTX_INPROC_SERVER, IID_IUnknown, oUnknown) Then
 
        Set oActiveDesktop = oUnknown
        
        oActiveDesktop.ApplyChanges AD_APPLY_ALL
        
        On Error Resume Next
        oActiveDesktop.ApplyChanges AD_APPLY_ALL Or AD_APPLY_FORCE
        
        If Err.Number <> 0 Then
            On Error GoTo ErrorHandler
            'SendF5toDesktop    ' так нельзя. Вызывает нежелательный артифакт: ярлыки накладываются друг на друга.
                                ' Следует вызывать F5 через некоторое время. Вставил код после того, как
                                ' пользователь нажмет ОК в сообщении с результатом лечения.
        End If
    
        Set oActiveDesktop = Nothing
        Set oUnknown = Nothing
    End If
    
    Exit Sub
ErrorHandler:
    AppendErrorLogFormat Now, Err, "Parser.RefreshLNK"
    Resume Next
End Sub
 
Public Sub SendF5toDesktop()
    Const GW_CHILD      As Long = 5&
    Const WM_KEYDOWN    As Long = 256&
    Const VK_F5         As Long = &H74&
    
    Dim hwnd                As Long
    Dim HwndChild           As Long
    
    hwnd = FindWindow("Progman", "Program Manager")
   
    HwndChild = GetWindow(hwnd, GW_CHILD)
    
    If HwndChild Then
        PostMessage HwndChild, WM_KEYDOWN, VK_F5, 1&
    End If
End Sub