Iterating unregistered add-ins (.xla) - vba

I need help in
figuring out how to iterate through currently open Excel add-in files (.xla) that have not been registered in Excel using the Tools > Add-ins menu path.
more specifically, I am interested in any workbook that doesn't appear in the Add-In dialog, but has ThisWorkbook.IsAddin = True.
Demonstrating the issue:
Trying to loop through workbooks as follows doesn't get workbooks with .AddIn = True:
Dim book As Excel.Workbook
For Each book In Application.Workbooks
Debug.Print book.Name
Next book
Looping through add-ins doesn't get add-ins that are not registered:
Dim addin As Excel.AddIn
For Each addin In Application.AddIns
Debug.Print addin.Name
Next addin
Looping through the VBProjects collection works, but only if user has specifically trusted access to the Visual Basic Project in the Macro Security settings - which is rarely:
Dim vbproj As Object
For Each vbproj In Application.VBE.VBProjects
Debug.Print vbproj.Filename
Next vbproj
However, if the name of the workbook is known, the workbook can be referenced directly regardless of whether it is an add-in or not:
Dim book As Excel.Workbook
Set book = Application.Workbooks("add-in.xla")
But how the heck to get reference to this workbook if the name is not known, and user's macro security settings cannot be relied on?

As of Office 2010, there is a new collection .AddIns2 which is the same as .AddIns but also includes the unregistered .XLA plug-ins.
Dim a As AddIn
Dim w As Workbook
On Error Resume Next
With Application
For Each a In .AddIns2
If LCase(Right(a.name, 4)) = ".xla" Then
Set w = Nothing
Set w = .Workbooks(a.name)
If w Is Nothing Then
Set w = .Workbooks.Open(a.FullName)
End If
End If
Next
End With

I have had issues with addins that are installed (and in the VBE) not being available via user's Addin on Exel 2013 (in a work environment).
Tinkering with the solution from Chris C gave a good workaround.
Dim a As AddIn
Dim wb As Workbook
On Error Resume Next
With Application
.DisplayAlerts = False
For Each a In .AddIns2
Debug.Print a.Name, a.Installed
If LCase(Right$(a.Name, 4)) = ".xla" Or LCase(Right$(a.Name, 5)) Like ".xla*" Then
Set wb = Nothing
Set wb = .Workbooks(a.Name)
wb.Close False
Set wb = .Workbooks.Open(a.FullName)
End If
Next
.DisplayAlerts = True
End With

I'm still on the lookout for a sane solution for this problem, but for the time being it seems that reading the window texts of all workbook windows gives a collection of all open workbooks, add-in or not:
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 Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount 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
Public Function GetAllOpenWorkbooks() As Collection
'Retrieves a collection of all open workbooks and add-ins.
Const EXCEL_APPLICATION_WINDOW As String = "XLDESK"
Const EXCEL_WORKBOOK_WINDOW As String = "EXCEL7"
Dim hWnd As Long
Dim hWndExcel As Long
Dim contentLength As Long
Dim buffer As String
Dim bookName As String
Dim books As Collection
Set books = New Collection
'Find the main Excel window
hWndExcel = FindWindowEx(Application.hWnd, 0&, EXCEL_APPLICATION_WINDOW, vbNullString)
Do
'Find next window
hWnd = FindWindowEx(hWndExcel, hWnd, vbNullString, vbNullString)
If hWnd Then
'Create a string buffer for 100 chars
buffer = String$(100, Chr$(0))
'Get the window class name
contentLength = GetClassName(hWnd, buffer, 100)
'If the window found is a workbook window
If Left$(buffer, contentLength) = EXCEL_WORKBOOK_WINDOW Then
'Recreate the buffer
buffer = String$(100, Chr$(0))
'Get the window text
contentLength = GetWindowText(hWnd, buffer, 100)
'If the window text was returned, get the workbook and add it to the collection
If contentLength Then
bookName = Left$(buffer, contentLength)
books.Add Excel.Application.Workbooks(bookName), bookName
End If
End If
End If
Loop While hWnd
'Return the collection
Set GetAllOpenWorkbooks = books
End Function

What about this:
Public Sub ListAddins()
Dim ai As AddIn
For Each ai In Application.AddIns
If Not ai.Installed Then
Debug.Print ai.Application, ai.Parent, ai.Name, ai.FullName
End If
Next
End Sub
Any use?

Use =DOCUMENTS, an Excel4 macro function.
Dim Docs As Variant
Docs = Application.Evaluate("documents(2)")
Here's the documentation for it (available here):
DOCUMENTS
Returns, as a horizontal array in text form, the names of the specified open workbooks in alphabetic order. Use DOCUMENTS to retrieve the names of open workbooks to use in other functions that manipulate open workbooks.
Syntax
DOCUMENTS(type_num, match_text)
Type_num is a number specifying whether to include add-in workbooks in the array of workbooks, according to the following table.
Type_num Returns
1 or omitted Names of all open workbooks except add-in workbooks
2 Names of add-in workbooks only
3 Names of all open workbooks
Match_text specifies the workbooks whose names you want returned and can include wildcard characters. If match_text is omitted, DOCUMENTS returns the names of all open workbooks.

Is iterating through the registry a possibility? I know that that doesn't give you a snapshot of what your instance of Excel is using, but what a new instance would use - but depending on what you need it for, it might be good enough.
The relevant keys are:
'Active add-ins are in values called OPEN*
HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\Options
'Inactive add-ins are in values of their full path
HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\Add-in Manager

Related

How to read FileNames in a given Folder on MAC?

My goal is to read the FileNames of all png files in a given folder.
I've Windows VBA code which uses the ActiveX FileSystemObject.
On a MAC This code results in
"runtime error 429 activex component can't create object"
Function ReadFileNames(ByVal sPath As String) As Integer
Dim oFSO, oFolder, oFile As Object
Dim sFileName As String
Set oFSO = CreateObject("scripting.FileSystemObject")
Set oFolder = oFSO.getfolder(sPath)
For Each oFile In oFolder.Files
If Not oFile Is Nothing And Right(LCase(oFile.Name), 4) = ".png" Then ' read only PNG-Files
sFileName = oFile.Name
' do something with the FileName ...
End If
Next oFile
End Function
Here is a sub, using the native VBA DIR command, listing EXCEL workbooks in a folder by printing their names on the debug window:
Public Sub DirXlList()
Const cstrPath As String = "c:\users\xxxx\misc\"
Dim strDirItem As String
strDirItem = Dir(cstrPath & "*.xlsx")
While strDirItem <> ""
Debug.Print "FileName: " & strDirItem, "FullPath: " & cstrPath & strDirItem
strDirItem = Dir()
DoEvents
Wend
End Sub
Does this help? In
Update: doevents command allows Excel to process other pending user interface activities, such as window refreshes, mouse-clicks. If you have lots of files (thousands) in a folder, Excel may appear unresponsive/frozen in a loop like this. It is not necessary, as it will become responsive again, once it completes the loop. If you have only a few hundred files then it is an overkill. Remove and try.
VBA for Mac can link to the entire c standard library, like this example:
Private Declare PtrSafe Function CopyMemory_byPtr Lib "libc.dylib" Alias "memmove" (ByVal dest As LongPtr, ByVal src As LongPtr, ByVal size As Long) As LongPtr
I'm too lazy to write out relevant examples for you, but if, by chance, you are familiar with using the c standard library for file manipulation, you can just do it that way.

Return focus to ThisWorkbook.Activesheet after XMLHTTP60 file download

Situation:
I am unable to return focus to the Excel application after initiating a file download.
My usual tricks of AppActivate and Application.hwnd , when working between applications, don't seem to be working this time. I haven't had a problem doing this before so don't know if I am being particularly dense today, or, it is because I am involving a browser for the first time. I suspect it is the former.
Questions:
1) Can any one see where I am going wrong (why focus does not shift back to Excel)?
2) More importantly: Is there a way to download files in the background, using the default browser, keeping the focus on ThisWorkbook and thereby avoiding the issue altogether?
I am using a workaround of SendKeys "%{F4}" immediately after the download, at present, to close the browser and so am defaulting back to Excel.
Note: The default browser in my case is Google Chrome but clearly could be any browser.
What I have tried:
1) From #user1452705; focus didn't shift:
Public Declare Function SetForegroundWindow _
Lib "user32" (ByVal hwnd As Long) As Long
Public Sub Bring_to_front()
Dim setFocus As Long
ThisWorkbook.Worksheets("Sheet1").Activate
setfocus = SetForegroundWindow(Application.hwnd)
End Sub
2) Then I tried:
ThisWorkbook.Activate 'No shift in focus
Windows(ThisWorkbook.Name).Activate 'Nothing happened
Application.Windows(ThisWorkbook.Name & " - Excel").Activate 'Subscript out of range
3) AppActivate using Title as actually displayed in Window:
AppActivate "AmbSYS_testingv14.xlsm" & " - Excel" 'Nothing happened
4) More desperate attempts:
AppActivate Application.Caption 'Nothing happened
AppActivate ThisWorkbook.Name & " - Excel" 'Nothing happened
AppActivate ThisWorkbook.Name 'Nothing happened
AppActivate "Microsoft Excel" 'Invalid proc call
4) Finally, the current version of my code is using #ChipPearson's sub ActivateExcel , which also has no effect:
Module 1:
Public Sub DownloadFiles()
'Tools > ref> MS XML and HTML Object lib
Dim http As XMLHTTP60
Dim html As HTMLDocument
Set http = New XMLHTTP60
Set html = New HTMLDocument
With http
.Open "GET", "https://www.england.nhs.uk/statistics/statistical-work-areas/ambulance-quality-indicators/ambulance-quality-indicators-data-2017-18/", False
.send
html.body.innerHTML = .responseText
End With
'Test Download code
html.getElementsByTagName("p")(4).getElementsByTagName("a")(0).Click
' Application.Wait Now + TimeSerial(0, 0, 3) 'pause for downloads to finish before files
'Other code
ActivateExcel
End Sub
Module 2:
Option Explicit
Option Compare Text
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modActivateExcel
' By Chip Pearson, www.cpearson.com, chip#cpearson.com
' http://www.cpearson.com/excel/ActivateExcelMain.aspx
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Window API Declarations
' These Declares MUST appear at the top of the
' code module, above and before any VBA procedures.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare PtrSafe Function BringWindowToTop Lib "user32" ( _
ByVal HWnd As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function SetFocus Lib "user32" ( _
ByVal HWnd As Long) As Long
Public Sub ActivateExcel()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ActivateExcel
' This procedure activates the main Excel application window,
' ("XLMAIN") moving it to the top of the Z-Order and sets keyboard
' focus to Excel.
'
' !!!!!!!!!!!!!!!!!!!!!!!!!
' NOTE: This will not work properly if a VBA Editor is open.
' If a VBA Editor window is open, the system will set focus
' to that window, rather than the XLMAIN window.
' !!!!!!!!!!!!!!!!!!!!!!!!!
'
' This code should be able to activate the main window of any
' application whose main window class name is known. Just change
' the value of C_MAIN_WINDOW_CLASS to the window class of the
' main application window (e.g., "OpusApp" for Word).
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Res As Long ' General purpose Result variable
Dim XLHWnd As Long ' Window handle of Excel
Const C_MAIN_WINDOW_CLASS = "XLMAIN"
'''''''''''''''''''''''''''''''''''''''''''
' Get the window handle of the main
' Excel application window ("XLMAIN"). If
' more than one instance of Excel is running,
' you have no control over which
' instance's HWnd will be retrieved.
' Related Note: You MUST use vbNullString
' not an empty string "" in the call to
' FindWindow. When calling API functions
' there is a difference between vbNullString
' and an empty string "".
''''''''''''''''''''''''''''''''''''''''''
XLHWnd = FindWindow(lpClassName:=C_MAIN_WINDOW_CLASS, _
lpWindowName:=vbNullString)
If XLHWnd > 0 Then
'''''''''''''''''''''''''''''''''''''''''
' If HWnd is > 0, FindWindow successfully
' found the Excel main application window.
' Move XLMAIN to the top of the
' Z-Order.
'''''''''''''''''''''''''''''''''''''''''
Res = BringWindowToTop(HWnd:=XLHWnd)
If Res = 0 Then
Debug.Print "Error With BringWindowToTop: " & _
CStr(Err.LastDllError)
Else
'''''''''''''''''''''''''''''''''
' No error.
' Set keyboard input focus XLMAIN
'''''''''''''''''''''''''''''''''
SetFocus HWnd:=XLHWnd
End If
Else
'''''''''''''''''''''''''''''''''
' HWnd was 0. FindWindow couldn't
' find Excel.
'''''''''''''''''''''''''''''''''
Debug.Print "Can't find Excel"
End If
End Sub
Additional references:
1) Toggle between Excel and IE
2) VBA API declarations. Bring window to front , regardless of application ; link also in main body
3) Return focus to excel after finishing downloading file with Internet explorer
4) Set focus back to the application window after showing userform
5) Close the application with sendkeys like ALt F4
Thanks to #OmegaStripes and #FlorentB for their input.
Using #OmegaStripes suggested method I:
Use XMLHTTP to get binary response content
Convert to UTF-8
Parse to extract the required URL
Use a new XMLHTTP to download binary
Use ADODB.Stream to write out file
Works a treat and no problems with shift in focus.
Notes: For step 3, I used the approach by #KarstenW to write the string , the converted responseText string, out to a txt file for examination to determine how to access the URL of interest.
Option Explicit
Public Const adSaveCreateOverWrite As Byte = 2
Public Const url As String = "https://www.england.nhs.uk/statistics/statistical-work-areas/ambulance-quality-indicators/ambulance-quality-indicators-data-2017-18/"
Public Const adTypeBinary As Byte = 1
Public Const adTypeText As Byte = 2
Public Const adModeReadWrite As Byte = 3
Public Sub DownLoadFiles()
Dim downLoadURL As String
Dim aBody As String
' Download via XHR
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url, False
.send
' Get binary response content
aBody = BytesToString(.responseBody, "UTF-8")
End With
Dim respTextArr() As String
respTextArr = Split(Split(aBody, "New AmbSYS Indicators")(0))
downLoadURL = Split(respTextArr(UBound(respTextArr)), Chr$(34))(1)
Dim urlArr() As String
Dim fileName As String
Dim bBody As Variant
Dim sPath As String
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", downLoadURL, False
.send
urlArr = Split(downLoadURL, "/")
fileName = urlArr(UBound(urlArr))
bBody = .responseBody
sPath = ThisWorkbook.Path & "\" & fileName
End With
' Save binary content to the xls file
With CreateObject("ADODB.Stream")
.Type = 1
.Open
.Write bBody
.SaveToFile sPath, adSaveCreateOverWrite
.Close
End With
' Open saved workbook
With Workbooks.Open(sPath, , False)
End With
End Sub
Public Function BytesToString(ByVal bytes As Variant, ByVal charset As String) As String
With CreateObject("ADODB.Stream")
.Mode = adModeReadWrite
.Type = adTypeBinary
.Open
.Write bytes
.Position = 0
.Type = adTypeText
.charset = charset
BytesToString = .ReadText
End With
End Function
For Excel 2013 please see here a solution that worked for me
In summary, change this:
AppActivate "Microsoft Excel"
to
AppActivate "Excel
Note: a pause before the command can help (at least in my case):
Application.Wait (Now + TimeValue("0:00:1"))

Word VBA causing issues in template

I have a Word 2010 template with fields, and drop down lists etc and a save button to save the document in a certain place with a certain name. Part of the file name I retrieve as the network username in VBA and another part of the file name is the Date. This works fine for me but when I attempt to test the document with another user the VBA code complains at the line below stating "Compile error: can't find project or library".
strUserName = (Environ$("username"))
If I changed the above to be like the line below instead and another user opens the template and clicks the save button
strUserName = "validnetworkname"
It then complains with the same error at the next VBA referencing which is
strDate = Date
What is wrong here please?
I use this function:
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Function UserName() As String
On Error GoTo ErrProc
Dim lnglen As Long
lnglen = 255
Dim strSpace As String
strSpace = String(254, 0)
Dim lngX As Long
lngX = apiGetUserName(strSpace, lnglen)
If lngX <> 0 Then GetUserName = Left(strSpace, lnglen - 1)
Leave:
On Error GoTo 0
Exit Function
ErrProc:
Resume Leave
End Function
To call it:
Dim user_ As String
user_ = UserName

VBA to read dimensions of Images from a list of webpages

My Goal:
I have a list of 14K URLs in a column in a worksheet.
Each of those URLs have an image in them. Something like a site banner.
I want to retrieve each of those banner image's dimensions into another column in the same sheet.
Can someone tell me if this is even possible in Excel VBA.
I have tried some things but all that is like beating around the bush and not straight forward.
I have tried to get the image's URLS . Then download those URLS to the HDD using 'URLDownloadToFile'. Then I get run some more code to get the dimensions.
Update: Sep/15/2014 04:10 PM EST
This is what I did:
I use this code in sheet 1 to load the URLs (from column A) and retrieve banner image URLs in column B
Private Sub GetEm_Click()
Dim ImageURL
Dim PageURL
Dim IE As New InternetExplorer
IE.Visible = True
For RowIndex = 0 To 15000
pURL = Sheet1.Range("A" & i).Value
On Error Resume Next
IE.Navigate pURL
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Dim Doc As HTMLDocument
Set Doc = IE.document
URL = Doc.getElementsByTagName("img")(1).src
Sheet1.Range("B" & i).Select 'I select and then populate the result value so that i can see the rows scrolling. This will give me an idea that the macro is still running.
Sheet1.Range("B" & i).Value = URL
Next i
IE.Quit
End Sub
The problem with this above code is that after around 150 rows, IE stops responding and my code hangs.
If this works, my plan then is to download the images using the image URLs from column B:
For this, as stated earlier I use:
'URLDownloadToFile'
Then once I have downloaded them, I run a vb script to get their dimensions.
I am hoping there is a better straight forward way of doing this.
You can do something like this (you'll have to change it to do specifically what you want):
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Sub GetImgData()
Dim objShell As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Long
Set objShell = CreateObject("Shell.Application")
For i = 1 To ActiveSheet.UsedRange.Rows.Count
URLDownloadToFile 0, Cells(i, 1).Value, "C:\temp.jpg", 0, 0
Set objFolder = objShell.Namespace("C:\")
Set objFile = objFolder.ParseName("temp.jpg")
MsgBox objFile.ExtendedProperty("Dimensions")
Kill "C:\temp.jpg"
Next
End Sub
Some important things to note though are:
If the URL is invalid or does not exist the file will not be created and no error will be thrown.
If the file could not be downloaded the temp file will not be created so the MsgBox line will throw an error.
You may need to parse the URL for the file type. I don't know what will happen if you download a .gif as a .jpg.
The output of objFile.ExtendedProperty is a bit odd and will likely need to be cleaned a little. (contains ?'s)

Rename and save ActiveDocument with VBA

Is it possible to rename the activedocument (the word document that I'm running the macro from) with VBA?
Right now I'm saving my activedocument under a new name and then attempt to delete the original. The latter part won't go through, so the original never gets deleted.
Anyone know if this is even possible?
I spent a lot of time doing this recently, because I disliked having to delete previous files when I did "Save As" - I wanted a "Save as and delete old file" answer. My answer is copied from here.
I added it to the quicklaunch bar which works wonderfully.
Insert following code into normal.dotm template (found in C:\Documents and Settings\user name\Application Data\Microsoft\Templates for Windows 7 for Word)
Save normal.dotm
Add this to the quicklaunch toolbar in Word.
Optional - remap a keyboard shortcut to this
Optional - digitally sign your template (recommended)
Note this actually moves the old file to the Recycle Bin rather than trashing completely and also sets the new file name in a very convenient fashion.
Option Explicit
'To send a file to the recycle bin, we'll need to use the Win32 API
'We'll be using the SHFileOperation function which uses a 'struct'
'as an argument. That struct is defined here:
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As Long
End Type
' function declaration:
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
'there are some constants to declare too
Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_SILENT = &H4
Function RecycleFile(FileName As String, Optional UserConfirm As Boolean = True, Optional HideErrors As Boolean = False) As Long
'This function takes one mandatory argument (the file to be recycled) and two
'optional arguments: UserConfirm is used to determine if the "Are you sure..." dialog
'should be displayed before deleting the file and HideErrors is used to determine
'if any errors should be shown to the user
Dim ptFileOp As SHFILEOPSTRUCT
'We have declared FileOp as a SHFILEOPSTRUCT above, now to fill it:
With ptFileOp
.wFunc = FO_DELETE
.pFrom = FileName
.fFlags = FOF_ALLOWUNDO
If Not UserConfirm Then .fFlags = .fFlags + FOF_NOCONFIRMATION
If HideErrors Then .fFlags = .fFlags + FOF_SILENT
End With
'Note that the entire struct wasn't populated, so it would be legitimate to change it's
'declaration above and remove the unused elements. The reason we don't do that is that the
'struct is used in many operations, some of which may utilise those elements
'Now invoke the function and return the long from the call as the result of this function
RecycleFile = SHFileOperation(ptFileOp)
End Function
Sub renameAndDelete()
' Store original name
Dim sOriginalName As String
sOriginalName = ActiveDocument.FullName
' Save As
Dim sFilename As String, fDialog As FileDialog, ret As Long
Set fDialog = Application.FileDialog(msoFileDialogSaveAs)
'set initial name so you don't have to navigate to
fDialog.InitialFileName = sOriginalName
ret = fDialog.Show
If ret <> 0 Then
sFilename = fDialog.SelectedItems(1)
Else
Exit Sub
End If
Set fDialog = Nothing
'only do this if the file names are different...
If (sFilename <> sOriginalName) Then
'I love vba's pretty code
ActiveDocument.SaveAs2 FileName:=sFilename, FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False, CompatibilityMode:=14
' Delete original (don't care about errors, I guess)
Dim hatersGonnaHate As Integer
hatersGonnaHate = RecycleFile(sOriginalName, False, True)
End If
End Sub