yadUK - Effective Information System Solutions » excel

Javascript Export HTML table to MS Excel (JScript)

admin — Wed, 22 Jul 2009 11:19:31 +0000

Here’s a little code snippet to export an HTML table to MS Excel through utilising ActiveXObject(“Excel.Application”) from Internet Explorer.

The JavaScript (in this case utilising Microsoft’s JScript) runs over the table displayed pulling out the relevant data and exporting into the instantiated copy of Excel. This is a working example based loosely on Microsoft’s http://support.microsoft.com/kb/234774 Knowledgebase Article “How to automate Excel from an HTML Web page by using JScript”.

Worth noting is that the garbage collection between the JScript and MS Excel doesn’t work too well and more often than not one can be left with the instantiated copy of MS Excel still in memory (see it in the Task Manager). One must manually remove these instances.

Perhaps dynamically inputting a module to clean up from within MS Excel on the workbook deactivating might clear this up – not tried this though!?

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Export to Excel Example</title>
<meta http-equiv="content-type" content="text/html; charset=iso-8859-1" />
<meta http-equiv="charset" content="iso-8859-1" />
<meta http-equiv="content-language" content="english" />
<meta http-equiv="expires" content="-1" />
<meta http-equiv="Pragma" content="no-cache" />
<meta http-equiv="imagetoolbar" content="false" />
<style>
body {
   margin: 0;
   font-family: verdana,arial,helvetica,sans-serif;
   font-size: .85em;
   padding: 3px;
}
th {background-color:#ccd;}
.odd{background-color:#DDDBDB;}
.even{background-color:#CECCCC;}

</style>
<script language="javascript" type="text/javascript">  
function ExportToExcel() {
	input_box=confirm("Export rows of table data to MS Excel?");
		if (input_box==true) {
			
			var xlApp = new ActiveXObject("Excel.Application");
			// Silent-mode:
			xlApp.Visible = true;
			xlApp.DisplayAlerts = false;
			var xlBook = xlApp.Workbooks.Add();
			xlBook.worksheets("Sheet1").activate;
			var XlSheet = xlBook.activeSheet;
			XlSheet.Name="JavaScript Export to Excel";
			
			// Store the sheet header names in an array
			var rows = tabletoexport.getElementsByTagName("tr");
			var columns = tabletoexport.getElementsByTagName("th");
			var data = tabletoexport.getElementsByTagName("td");
			
  			// Set Excel Column Headers and formatting from array
			for(i=0;i<columns.length;i++){
	   			XlSheet.cells(1,i+1).value= columns[i].innerText; //XlSheetHeader[i];
	   			XlSheet.cells(1,i+1).font.color="6";
	   			XlSheet.cells(1,i+1).font.bold="true";
	   			XlSheet.cells(1,i+1).interior.colorindex="45";
			}
			
			//run over the dynamic result table and pull out the values and insert into corresponding Excel cells
			var d = 0;
			for (r=2;r<rows.length+1;r++) { // start at row 2 as we've added in headers - so also add in another row!
				for (c=1;c<columns.length+1;c++) {
					XlSheet.cells(r,c).value = data[d].innerText;
					d = d + 1;
				}
			}
			
			//autofit the columns
			XlSheet.columns.autofit;
			
			// Make visible:
			xlApp.visible = true;
			xlApp.DisplayAlerts = true;
			CollectGarbage();
			//xlApp.Quit();
		}
}
</script>
</head>
<body>
	<input type="button" value="Export To Excel" onClick="ExportToExcel()">
	<table border="1" width="100%" id="tabletoexport">
		<tr>
			<th>Month</th>
			<th>Column 1</th>
			<th>Column 2</th>
			<th>Column 3</th>
			<th>Column 4</th>
		</tr>
		<tr class="even">
			<td>January</td>
			<td>123</td>
			<td>456</td>
			<td>798</td>
			<td>123</td>
		</tr>
		<tr class="odd">
			<td>February</td>
			<td>456</td>
			<td>798</td>
			<td>123</td>
			<td>456</td>
		</tr>
		<tr  class="even">
			<td>March</td>
			<td>798</td>
			<td>123</td>
			<td>456</td>
			<td>789</td>
		</tr>
		<tr class="odd">
			<td>April</td>
			<td>123</td>
			<td>456</td>
			<td>789</td>
			<td>123</td>
		</tr>
		<tr  class="even">
			<td>May</td>
			<td>456</td>
			<td>789</td>
			<td>123</td>
			<td>456</td>
		</tr>
		<tr class="odd">
			<td>June</td>
			<td>789</td>
			<td>123</td>
			<td>456</td>
			<td>789</td>
		</tr>
		<tr class="even">
			<td>July</td>
			<td>123</td>
			<td>456</td>
			<td>789</td>
			<td>123</td>
		</tr>
		<tr class="odd">
			<td>August</td>
			<td>456</td>
			<td>789</td>
			<td>123</td>
			<td>456</td>
		</tr>
		<tr  class="even">
			<td>September</td>
			<td>789</td>
			<td>123</td>
			<td>456</td>
			<td>789</td>
		</tr>
		<tr class="odd">
			<td>October</td>
			<td>123</td>
			<td>456</td>
			<td>789</td>
			<td>123</td>
		</tr>
		<tr class="even">
			<td>November</td>
			<td>456</td>
			<td>789</td>
			<td>123</td>
			<td>456</td>
		</tr>
		<tr class="odd">
			<td>December</td>
			<td>789</td>
			<td>123</td>
			<td>456</td>
			<td>789</td>
		</tr>
	</table>
</body>
</html>

Export Access to Excel with Custom Headers

admin — Mon, 20 Jul 2009 11:26:46 +0000

Have you noticed how the “out the box” solution to export your dataset from MS Access to MS Excel doesn’t give much room to give custom headers to your worksheet?

Through utlising ActiveX you can instantiate a copy of MS Excel in memory to add in your own custom headers etc. prior to exporting your MS Access dataset into the worksheet.

The below code example shows you how to add 5 custom headers to your sheet. Just add in your own SQL query where it is indicated.

Private Sub btn_export_excel_Click()
   
    Dim mySQL, thepos, theleft, theright, test As String
    Dim i, iNumCols  As Integer
    Dim DB As DAO.Database
    Dim rs As DAO.Recordset
    
    Set DB = CurrentDb
    
    With Me.yourformname.Form.RecordsetClone
        If .RecordCount > 0 Then .MoveLast
        test = .RecordCount
    End With
    
    If test < 65535 Then
        'create output table and output
        If MsgBox("Export selected data?", vbOKCancel, "Export . . ?") = vbOK Then
            
            Dim oApp As New Excel.Application
            Dim oBook As Excel.Workbook
            Dim oSheet As Excel.Worksheet
            Dim oRange As Excel.Range
			
			mySQL = "enter in whatever youSQL query is here"
                  
            Set rs = DB.OpenRecordset(mySQL, dbOpenSnapshot)
            Set oBook = oApp.Workbooks.Add
            Set oSheet = oBook.Worksheets(1)
            
            oSheet.Cells(1, 1).Value = "HEADER 1"
            oSheet.Cells(2, 1).Value = "HEADER 2"
            oSheet.Cells(3, 1).Value = "HEADER 3"
            oSheet.Cells(4, 1).Value = "HEADER 4"
            oSheet.Cells(5, 1).Value = "HEADER 5"
            
            'Format the header
            oSheet.Cells(1, 1).Font.Bold = True
            
            With oSheet
                Set oRange = .Range("A5:AL5")
            End With
            
            With oRange
                .MergeCells = True
            End With
           
            'Add the field names in row 7
            iNumCols = rs.Fields.count
            For i = 1 To iNumCols
                oSheet.Cells(7, i).Value = rs.Fields(i - 1).Name
            Next
            
            'Add the data starting at cell A8
            oSheet.Range("A8").CopyFromRecordset rs
            
            'Format the header row as bold and autofit the columns
            With oSheet.Range("a7").Resize(1, iNumCols)
                .Font.Bold = True
                .EntireColumn.AutoFit
            End With
            oSheet.Columns("A:A").ColumnWidth = 10.14
            
            oApp.Visible = True
            oApp.UserControl = True
            
            'make sure we clean up the instantiated Excel app!!
            'oApp.Quit
            Set oApp = Nothing
            Set oBook = Nothing
            Set oSheet = Nothing
            rs.Close
            DB.Close
            
        End If
    Else
        MsgBox "Sorry - your export is larger than what can be held within Excel!" & vbCrLf & vbCrLf & " Please consider revising your dataset.", vbCritical, "Export Error"
    End If
    
End Sub

Excel Split Firstname Lastname 2 Columns

admin — Tue, 26 May 2009 13:00:37 +0000

Excellent post in the MSDN microsoft.public.excel.programming community regarding the splitting of a firstname and lastname into two seperate columns. The honours go to someone called “Bam”.

Last Name
=IF(ISERROR(LEFT(B2,FIND(“,”,B2,1)-1)),RIGHT(B2,LEN(B2)-(FIND(” “,B2,1))),LEFT(B2,FIND(“,”,B2,1)-1))

First Name
=IF(ISERROR(RIGHT(B1,LEN(B1)-(FIND(“,”,B1,1)+1))),LEFT(B1,FIND(” “,B1,1)+1-1),RIGHT(B1,LEN(B1)-(FIND(“,”,B1,1)+1)))

Hyperion Essbase – Excel – Auto-connect

admin — Fri, 15 May 2009 12:12:47 +0000

A few folk have asked how to just connect automatically to Essbase from Excel VBA. Please find below a simple VBA sub stripped back to show this. Use the following to initialise with your own details in place.

Call initialise("xxx","xxx","xxx","xxx","xxx")

Hyperion Essbase -> Excel -> Access -> automagic

admin — Sat, 25 Apr 2009 17:52:50 +0000

Accessing Hyperion Essbase is no problem directly from their MS Excel plugins. Though what happens if one wants to import on-the-fly and put that into MS Access so you can deliver your MI: Management Information, alongside current data without having to analyse and alter Hyperion Essbase output in Excel before exporting to textfile format or CSV before manipulation?

Well, why not try the below code!

The below function run within MS Access will write an “Essbase connection plugin” before instantiating a copy of MS Excel to run Essbase from. Unfortunately if you don’t write out and pull in the textfile to create a module in Excel as is within the code Microsoft’s security permissions now deny access. Give them their due – it was a good move for certain issues.

After the “plugin” is pulled into the MS Excel workbook it fires a connection to Essbase and in this case draws down and partitions the relevant info to worksheets. Note the code will require setting up against whatever Essbase fields you require from your system.

The code as you will see at the bottom will clear down any previous retrieval before using MS Access’ TransferSpreadsheet import functionality to pull in the retreived workbook. The code also requires a table within MS Access to hold your Hyperion Essbase login details. In this case the table is called tbl_essbase_credentials and can be seen within the code. The Excel workbook is cleared down and you are left with your Hyperion Essbase MS Excel retrieval in your MS Access database.

Way to go!

So the process from MS Access is to run function and -> create a module for import into MS Excel -> start a virtual copy of MS Excel -> import the module into the virtual copy of MS Excel -> run virtual module to connect to Hyperion Essbase and download required data -> save MS Excel workbook and transfer the spreadsheet into MS Access -> clean up. All from within MS Access!

Function Essbase()
    Dim sql, test, row, theyear As String
    Dim retval As Long
    Dim a, i, iNumCols, counter As Integer
    Dim fld As Field
    Dim db As DAO.database
    Dim rs As DAO.Recordset
    
    'Start a new workbook in Excel - note db reference "Microsoft Excel 11.0 Object Library" included
    Dim oApp As New Excel.application
    Dim oBook As Excel.Workbook
    Dim oSheet As Excel.Worksheet
    
    DoCmd.SetWarnings False

Set oBook = oApp.Workbooks.Add
        Set db = CurrentDb
        
        'set control of Excel
        oApp.Visible = True
        oApp.UserControl = True
              
        'create module on filesystem to import Essbase macros into the dynamic workbook
        Open pathname & "essbase.txt" For Output As #1
            Print #1, "Declare Function EssMenuVRetrieve Lib ""ESSEXCLN.XLL"" () As Long"
            Print #1, "Declare Function EssMenuVConnect Lib ""ESSEXCLN.XLL"" () As Long"
            Print #1, "Declare Function EssVConnect Lib ""ESSEXCLN.XLL"" (ByVal sheetName As Variant, ByVal userName As Variant, ByVal password As Variant, ByVal server As Variant, ByVal application As Variant, ByVal database As Variant) As Long"
            Print #1, "Declare Function EssVSetGlobalOption Lib ""ESSEXCLN.XLL"" (ByVal item As Long, ByVal globalOption As Variant) As Long"
    
            Print #1, "Public Sub startEssbase()"
            Print #1, "Dim sts As Long"
            
                'set Essbase credentials
                Set rs = db.OpenRecordset("SELECT tbl_essbase_credentials.variable, tbl_essbase_credentials.data FROM tbl_essbase_credentials;")
                Do While Not rs.EOF
                    row = rs.Fields(0) & " = """ & rs.Fields(1) & """"
                    Print #1, row
                rs.MoveNext
                Loop
    
            Print #1, "     sts = EssVSetGlobalOption(6, False)"
            Print #1, "     sts = EssVConnect(Null, User, password, server, appname, dbname)"
            Print #1, "     sts = EssVSetGlobalOption(6, True)"
            Print #1, "End Sub"
            Print #1, "Public Sub retrieveEssbase()"
            Print #1, "     x = EssMenuVRetrieve()"
            Print #1, "End Sub"
            Print #1, "Public Sub transposer()"
            Print #1, "Dim nom, res As String"
            Print #1, "Dim valN As Double"
            Print #1, "Dim counter, i As Integer"
            Print #1, ""
            Print #1, "application.ScreenUpdating = False"
            Print #1, "    Worksheets(""Sheet2"").Cells.ClearContents"
            Print #1, "    Sheets(""P1"").Select"
            Print #1, "        headercol = Cells(1, application.Columns.Count).End(xlToLeft).Column"
            Print #1, "        Cells(1, headercol).End(xlDown).Select"
            Print #1, "        headerend = CInt(ActiveCell.row) + 2"
            Print #1, "        finalrow = Range(""E65536"").End(xlUp).row - headerend"
            Print #1, "        finalcol = Cells(headerend, application.Columns.Count).End(xlToLeft).Column"
            Print #1, "        counter = 0"
            Print #1, "        For j = headercol To finalcol"
            Print #1, "            Sheets(""P1"").Select"
            Print #1, "            counter = counter + 1"
            Print #1, "            nom = Cells(headerend, headercol).Offset(0, counter - 1).Value"
            Print #1, "            danext = (finalrow) * counter"
            Print #1, ""
            Print #1, "            For i = 0 To finalrow"
            Print #1, "                    Sheets(""P1"").Select"
            Print #1, "                    res = Cells(i + headerend, headercol + counter - 1).Offset(1, -1 - counter).Value"
            Print #1, "                    valN = Cells(i + headerend, headercol + counter - 1).Offset(1, 0).Value"
            Print #1, "                    Sheets(""Sheet2"").Select"
            Print #1, "                    Range(""a"" & i + headerend).Offset(danext - finalrow, 0).Value = nom"
            Print #1, "                    Range(""b"" & i + headerend).Offset(danext - finalrow, 0).Value = res"
            Print #1, "                    Range(""c"" & i + headerend).Offset(danext - finalrow, 0).Value = valN"
            Print #1, "            Next i"
            Print #1, "            "
            Print #1, "        Next j"
            Print #1, ""
            Print #1, "    Sheets(""Sheet2"").Select"
            Print #1, "    Range(""A3"").Select"
            Print #1, "    Range(Selection, Selection.End(xlDown)).Offset(-1, 0).Select"
            Print #1, "    Range(Selection, Selection.End(xlToRight)).Select"
            Print #1, "    Selection.Delete Shift:=xlUp"
            Print #1, "    Range(""A1"").Value = ""nominal"""
            Print #1, "    Range(""B1"").Value = ""responsibility"""
            Print #1, "    Range(""C1"").Value = ""value"""
            Print #1, "application.ScreenUpdating = True"
            Print #1, "End Sub"
        Close #1
        
        'import Essbase module
        oApp.VBE.ActiveVBProject.VBComponents.Import pathname & "essbase.txt"
        'delete the text file
        Kill pathname & "essbase.txt"
        'start Essbase
        Shell ("C:Hyperionessbasebinessexcln.xll")
        'run Essbase macro to connect
        oApp.Run "startEssbase"
        theyear = "2008"
        counter = 1
    
        'For counter = 1 To 12
    
            Set oSheet = oBook.Worksheets(counter)
            oSheet.Activate
            oSheet.Name = "P" & counter
            'lets set the time period
            oSheet.Cells(8, 4).Value = "'P" & counter & " " & theyear & " YTD"
            
            'lets add the Essbase headers
            Set rs = db.OpenRecordset("SELECT tbl_essbase_header.data FROM tbl_essbase_header;")
            For Each fld In rs.Fields
                Do Until rs.EOF = True
                    oSheet.Cells(rs.AbsolutePosition + 1, 4).Value = "'" & fld
                rs.MoveNext
                Loop
                rs.MoveFirst
            Next fld
            
            'lets add the nominals
            sql = "SELECT tbl_nominal.nominal FROM tbl_nominal;"
            Set rs = db.OpenRecordset(sql, dbOpenSnapshot)
            For Each fld In rs.Fields
                Do Until rs.EOF = True
                    oSheet.Cells(10, rs.AbsolutePosition + 4).Value = "'" & fld
                rs.MoveNext
                Loop
                rs.MoveFirst
            Next fld
            
            'lets add the responsibilities
            sql = "SELECT tbl_responsibility.responsibility FROM tbl_responsibility;"
            Set rs = db.OpenRecordset(sql, dbOpenSnapshot)
            For Each fld In rs.Fields
                Do Until rs.EOF = True
                    oSheet.Cells(rs.AbsolutePosition + 11, 2).Value = "'" & fld
                rs.MoveNext
                Loop
                rs.MoveFirst
            Next fld
            
            'run Essbase macro to retrieve
            oApp.Run "retrieveEssbase"
            oApp.Run "transposer"
            
            'clean out previous retrieval
            DoCmd.RunSQL ("DELETE tbl_retrieval.* FROM tbl_retrieval;")
            oApp.ActiveWorkbook.SaveAs (pathname & "tmp.xls")
            
            'clean up
            'oApp.Quit
            Set oApp = Nothing
            Set oBook = Nothing
            Set oSheet = Nothing
            
            'transfer in
            DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "tbl_retrieval", pathname & "tmp.xls", True, "Sheet2!A1:IV65536"
            
            'clean up
            DoCmd.RunSQL ("DELETE tbl_retrieval.nominal, tbl_retrieval.responsibility, tbl_retrieval.value FROM tbl_retrieval WHERE (((tbl_retrieval.responsibility) Is Null));")
            Kill pathname & "tmp.xls"
            
    DoCmd.SetWarnings True
            
    'Close the Database and Recordset
    rs.Close
    db.Close

End Function

Export Excel to HTML

admin — Fri, 20 Feb 2009 04:35:17 +0000

Having found on more than a few occasions that MS Excel’s output to HTML is more than a little bloated and not very editable I needed a way to output clean HTML markup to a simple shared folder area.

This was originally used in Excel 97 and has not been tested in later versions though will most likely work fine.

Sub ExportToHTML()

Dim ws As Worksheet
Dim DocDestination 'name of the result file
Dim MyRange 'cells to be exported as html

xthLine = 1
CL1 = "#FFFF99"
CL2 = "#DADADA"
whichsheet = 0

If MsgBox("Export all sheets from this workbook:" & vbCrLf & Name, vbOKCancel, "E x p o r t") = vbOK Then

For Each ws In ActiveWorkbook.Worksheets
        whichsheet = whichsheet + 1

Sheets(whichsheet).Select
        MyRange = "$A$1:$J$58" 'set the range to export
        DocDestination = "whereyouwanthtmltoexport" & ActiveSheet.Name + ".html" 'set name of output file to the activesheet

ColCount = Range(MyRange).Columns.Count
        RowCount = Range(MyRange).Rows.Count
        Calculate

Open DocDestination For Output As 1

'Create HTML
        Print #1, "<!DOCTYPE html PUBLIC " & Chr(34) & "-//W3C//DTD XHTML 1.0 Transitional//EN" & Chr(34) & " " & Chr(34) & "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd" & Chr(34) & ">" & Chr$(13)
        Print #1, "<html xmlns=" & Chr(34) & "http://www.w3.org/1999/xhtml" & Chr(34) & ">" & Chr$(13)
        Print #1, "<head>" & Chr$(13)
        Print #1, "<title>" & ActiveSheet.Name & "</title>" & Chr$(13)
        Print #1, "<meta http-equiv=" & Chr(34) & "content-type" & Chr(34) & " content=" & Chr(34) & "text/html; charset=iso-8859-1" & Chr(34) & " />" & Chr$(13)
        Print #1, "<meta http-equiv=" & Chr(34) & "Charset" & Chr(34) & "content=" & Chr(34) & "iso-8859-1" & Chr(34) & " />" & Chr$(13)
        Print #1, "<meta http-equiv=" & Chr(34) & "expires" & Chr(34) & "content=" & Chr(34) & "-1" & Chr(34) & " />" & Chr$(13)
        Print #1, "<meta http-equiv=" & Chr(34) & "Pragma" & Chr(34) & "content=" & Chr(34) & "no-cache" & Chr(34) & " />" & Chr$(13)
        Print #1, "<style type=" & Chr(34) & "Text/css" & Chr(34) & ">td{padding:0px 10px 0px 10px; align:center;}</style>" & Chr$(13)
        Print #1, "</head>" & Chr$(13)
        Print #1, "<body bgcolor=" & Chr(34) & "#9F9F9F" & Chr(34) & " >" & Chr$(13)
        Print #1, "<center>" & vbCrLf & "  <table>" & Chr$(13)

I = Val(Evryxlines) ' initalize i

Row = 0
        BGC = "#3333FF" 'Title colour
        While Row < RowCount

Row = Row + 1
            'DoEvents
            If (Not Range(MyRange).Rows(Row).Hidden) Then
                MV = ""
                Col = 0
                Colour = 0
                While Col < ColCount
                    Col = Col + 1
                    If (Not Range(MyRange).Columns(Col).Hidden) Then

'************************************************************************************
                        CellV = Range(MyRange).Cells(Row, Col).Text
                        If CellV = "" Then CellV = " "
                        Hza = Range(MyRange).Cells(Row,Col).HorizontalAlignment
                        If Hza = xlLeft Then CellA = ""
                        If Hza = xlCenter Then CellA = " align=" & Chr(34) & "center" & Chr(34) & ""
                        If Hza = xlRight Then CellA = " align=" & Chr(34) & "right" & Chr(34) & " "
                        If Range(MyRange).Cells(Row, Col).Font.Bold Then CellV = "<b>" & CellV & "</b>"
                        If Range(MyRange).Cells(Row, Col).Font.Italic Then CellV = "<i>" & CellV & "</i>"
                    '************************************************************************************

If BGC = "#3333FF" Then 'White font for the title bar
                        MV = MV & "        <td bgcolor=" & Chr$(34) & BGC & Chr$(34) & CellA & "><font color=" & Chr$(34) & "white" & Chr$(34) & "><b>" & CellV & "</b></font></td>"
                    Else
                        MV = MV & "        <td bgcolor=" & Chr$(34) & BGC & Chr$(34) & CellA & ">" & CellV & "</td>" & vbCrLf
                    End If
                    Else
                        MV = MV & "        <td>" & CellV & "</td>"
                    End If
                Wend
                Print #1, "    <tr>" & vbCrLf & MV & "    </tr>"
            End If

If Row = 2 Then
                BGC = "#9F9F9F" 'grey
            End If

If Row = 3 Then
                BGC = "#FFFFFF" 'white
            End If

If Row = 0 Or Row = 1 Or Row = 4 Then
                BGC = "#3333FF" 'blue
            End If

If Row > 3 Then
                If I = Val(xthLine) Then
                    I = 0
                        If BGC = CL1 Then
                            BGC = CL2
                        Else
                            BGC = CL1
                        End If
                End If
                I = I + 1
            End If

Wend

Print #1, "  </table>" & vbCrLf & "</center>" & vbCrLf
        Print #1, "<p>Updated: " & Date & vbCrLf
        Print #1, "</body>" & vbCrLf
        Print #1, "</html>" & Chr$(13)

Close 'Close the exported file

Else
    Exit Sub
End If

End Sub