'MODULE
Option Explicit
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As TCHOOSECOLOR) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type TCHOOSECOLOR
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As String
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Public Property Get GetColor(Optional AppHwnd As Long = 0, Optional Multiple As Boolean) As Long
Dim Color As TCHOOSECOLOR
Color.flags = 2 'Show full box includes custom
If Multiple = False Then 'If they only want one opened at a time give it an hwnd
Color.hwndOwner = AppHwnd 'when skipped program will keep focus
End If
Color.lStructSize = Len(Color)
Color.lpCustColors = 100
If CHOOSECOLOR(Color) <> 0 Then
GetColor = Color.rgbResult 'Set GetColor to the long value despite it saying rgb
Else
GetColor = vbNullString 'Not 0 because then it would be though black not an error
End If
End Property
Public Function ShowOpen(AppHwnd As Long, Filter As String, Title As String, Optional Multiple As Boolean) As String
On Error GoTo ErrorLoc
Dim OpenF As OPENFILENAME
OpenF.flags = &H4 ' no open as readonly box
If Multiple = True Then
OpenF.hwndOwner = AppHwnd 'set the window handle
End If
OpenF.lpstrFile = String(500, Chr(0))
OpenF.lpstrFileTitle = String(500, Chr(0))
OpenF.lpstrFilter = Filter
OpenF.lpstrTitle = Title
OpenF.lStructSize = Len(OpenF)
OpenF.nMaxFile = 501
OpenF.nMaxFileTitle = 501
If GetOpenFileName(OpenF) Then
ShowOpen = Replace(OpenF.lpstrFile, Chr(0), ""

Else
ErrorLoc:
ShowOpen = vbNullString 'No file error
End If
End Function
Public Function ShowSave(AppHwnd As Long, Filter As String, Title As String, Optional Multiple As Boolean) As String
On Error GoTo ErrorLoc
Dim SaveF As OPENFILENAME
SaveF.flags = &H2 Or &H4 'Prompt on overwrite, no read only box
If Multiple = False Then
SaveF.hwndOwner = AppHwnd
End If
SaveF.lpstrFile = String(500, Chr(0))
SaveF.lpstrFileTitle = String(500, Chr(0))
SaveF.lpstrFilter = Filter
SaveF.lpstrTitle = Title
SaveF.lStructSize = Len(SaveF)
SaveF.nMaxFile = 501
SaveF.nMaxFileTitle = 501
If GetSaveFileName(SaveF) Then
ShowSave = Replace(SaveF.lpstrFile, Chr(0), ""

Else
ErrorLoc:
ShowSave = vbNullString 'Error no file
End If
End Function
'FORM
Form1.Caption = ShowOpen(Me.hWnd, "All Files (*.*)" & Chr(0) & "*.*", "Open Dialog Example", False)
Form1.Caption = ShowSave(Me.hWnd, "All Files (*.*)" & Chr(0) & "*.*", "Save Dialog Example", False)
Form1.BackColor = GetColor(Me.hWnd, False)
You can play around with the hWnd and not only keep a timer running but access the form while the dialog box is open, also eliminating the need to reference the common dialog control ;o)
You could also eliminate the timer using GetTickCount and Sleep API.