VBA Closing Excel Spreadsheet In Internet Explorer Window without Saving Prompts

Hi all ,
SCENARIO:
We’ve an Excel Spredsheet opened with Internet Explorer ,as you should know funcions like

ThisWorkbook.Close False

donesn’t work because Excel’s file is opened in cache memory of Internet Explorer and you can’t refer to Excel Library as this file is open in Excel.
If Excel’s files is on server (for internet access it shoud be) you CAN’T save it.
For save you need to write a custom funcion wich saves sheets status and after retrive it , to do
this thing we’ve used SQL database here there is LWEBCODE function to SAVE value:

With ThisWorkbook
    For i = 1 To .Sheets.Count
        tbl = .Worksheets(i).Name
        tName = "EXCEL_" & tbl
        sql = "SELECT TABLE_NAME FROM INFORMATION_SCHEMA.TABLES WHERE (TABLE_TYPE = 'BASE TABLE')" & _
        " AND TABLE_NAME='" & tName & "'"
        Set rs = cn.Execute(sql)
        If rs.EOF Then
            sql = "CREATE TABLE [dbo].[" & tName & "] (" & _
            " [Row] [int] NOT NULL ," & _
            " [Col] [int] NOT NULL ," & _
            " [Val] [nvarchar] (250) COLLATE SQL_Latin1_General_CP1_CI_AS NULL ," & _
            " [SName] [nvarchar] (50) COLLATE SQL_Latin1_General_CP1_CI_AS NULL" & _
            ") ON [PRIMARY]"
            cn.Execute sql
        End If
        sql = "DELETE FROM " & tName
        cn.Execute sql

        For r = 1 To 1000' your max row used
            For c=1 to 100 ' your max column used
            If Worksheets(i).Cells(r, Colonna).Value "" Then
            sql = "INSERT INTO " & tName & " ( Row, Col, Val, SName ) VALUES (" & r & "," & c & ",'" & Worksheets(i).Cells(r, c).Value & "','" & Worksheets(i).Name & "')"
            Debug.Print sql
            cn.Execute sql
          
            Next c
        Next r
        End If
    Next i
End With
You have to implement LOAD function it isn’t hard.
For closing Excel’s file when is opened in IE (Internet Explorer)
We’ve used a VBA Timer getting from:
http://www.cpearson.com/excel/OnTime.aspx

Every thick of Timer Call CloseExcel() see this later
as
Public RunWhen As Double
Public Const cRunIntervalSeconds = 1 ' 1 seconds
Public Const cRunWhat = "TheSub" ' the name of the procedure to run

Sub StartTimer()
    RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
    Schedule:=True
End Sub

Sub TheSub()
    ''''''''''''''''''''''''
    ' LWEBCODE
    '
-Website Building & free script at http://lwebcode.blogspot.com/     ''''''''''''''''''''''''
    Debug.Print Format(Now, "HH:mm:ss")
    Call CloseExcel ''Every seconds we check if value was change and even close excel
    StartTimer ' Reschedule the procedure
End Sub


Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
    Schedule:=False
End Sub


In WorkBook Open Events I’ve put :

Private Sub Workbook_Open()
StartTimer
End Sub

Now chek if Excel files is open in IE or Excel  

Public Function ExcelOrIE() As String
Dim CName As String
On Error GoTo MustBeExcel
CName = ThisWorkbook.Container.Name
If InStr(1, UCase(CName), UCase("Internet Explorer")) > 0 Then
CName = CName
Else
CName = "Something Else"
End If
ExcelOrIE = CName
Exit Function
MustBeExcel:
ExcelOrIE = "EXCEL"
End Function
 
After this we’ve added a button in excel sheet which write a value in a hidden sheet and call Window Api to close
current tab of IE  

If ExcelOrIE "EXCEL" Tehn
ThisWorkbook.Sheets("Sheet1").Cells(2, 1) = "'---"
CloseApp ExcelOrIE, "IEFrame"
End If

Close App(), We suggest to put this in a separate module:
http://www.tek-tips.com/faqs.cfm?fid=6073
 
Private Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Private Declare Function GetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) _
As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDLAST = 1
Private Const GW_HWNDNEXT = 2
Private Const GW_HWNDPREV = 3
Private Const GW_OWNER = 4
Private Const GW_CHILD = 5
Private Const WM_CLOSE = &H10
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const KEYEVENTF_EXTENDEDKEY = &H1 'pressione del tasto (keyDown)
Const KEYEVENTF_KEYUP = &H2 'rilascio del tasto premuto (keyUp)
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Function FindWindowHwndLike(ByVal hWndStart As Long, _
ClassName As String, _
WindowTitle As String, _
level As Long, _
lHolder As Long) As Long
'finds the first window where the class name start with ClassName
'and where the Window title starts with WindowTitle, returns Hwnd
'----------------------------------------------------------------
Dim hwnd, WndChild, WndChild2 As Long
Dim sWindowTitle As String
Dim sClassName As String
Dim r As Long
'Initialize if necessary. This is only executed
'when level = 0 and hWndStart = 0, normally
'only on the first call to the routine.
If level = 0 Then
If hWndStart = 0 Then
hWndStart = GetDesktopWindow()
End If
End If
'Increase recursion counter
level = level + 1
'Get first child window
hwnd = GetWindow(hWndStart, GW_CHILD)
Do Until hwnd = 0
'Search children by recursion
lHolder = FindWindowHwndLike(hwnd, _
ClassName, _
WindowTitle, _
level, _
lHolder)
'Get the window text
sWindowTitle = Space$(255)
r = GetWindowText(hwnd, sWindowTitle, 255)
sWindowTitle = Left$(sWindowTitle, r)
'get the class name
sClassName = Space$(255)
r = GetClassName(hwnd, sClassName, 255)
sClassName = Left$(sClassName, r)
Debug.Print sClassName & " " & sWindowTitle
If InStr(1, sWindowTitle, WindowTitle, vbBinaryCompare) > 0 And _
sClassName Like ClassName & "*" Then
FindWindowHwndLike = hwnd
'#If Internet Explorer is opened close current tab
WndChild = FindWindowEx(hwnd, 0, "Frame Tab", vbNullString)
WndChild2 = FindWindowEx(WndChild, 0, "TabWindowClass", vbNullString)
PostMessage WndChild2, WM_CLOSE, 0, 0
lHolder = hwnd
Exit Function
End If
'Get next child window
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
Loop
FindWindowHwndLike = lHolder
End Function
Function CloseApp(ByVal strApp As String, _
ByVal strClass As String) As Long
'will find a window based on:
'the partial start of the Window title and/or
'the partial start of the Window class
'and then close that window
'for example, this will close Excel:
'CloseApp "", "XLM" and this will:
'CloseApp "Microsoft Excel", ""
'but this won't: CloseApp "", "LM"
'it will only close the first window that
'fulfills the criteria
'will return Hwnd if successfull, and 0 if not
'---------------------------------------------
Dim hwnd As Long
On Error GoTo ERROROUT
hwnd = FindWindowHwndLike(0, _
strClass, _
strApp, _
0, _
0)
If hwnd = 0 Then
CloseApp = 0
Exit Function
End If
'Post a message to the window to close itself
'--------------------------------------------
''PostMessage hwnd, WM_CLOSE, 0&, 0&
CloseApp = hwnd
Exit Function
ERROROUT:
On Error GoTo 0
CloseApp = 0
End Function
  
Remember CloseExcel() ? is the last function to do the trick : 

Public Function CloseExcel()
If ThisWorkbook.Sheets("Sheet1").Cells(99, 1) = "---" Then
SendKeys "{TAB}"
SendKeys "{ENTER}"
End If
End Function

Sending {TAB} you can automate selection of Excel prompt for Save File as usually options are
Yes , No, Cancel
sending 1 tab, you select No option and sending {ENTER} emulate button click and that’s All