VBA: Internet explorer control download - ms-access

Does anyone know of a way when using InternetExplorer.Application of using the FileDownload Event and what is possible with it? I'm trying to detect when IE is downloading a file so that when the file download is done the file is handled automatically.
There is a DownloadBegin and a DownloadComplete Events but this look to be talking about when navigating to a URL and not an accual file download.

You should be able to confirm the status of the download process.
Option Explicit
Declare PtrSafe 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 DownloadFileAPI()
Dim strURL As String
Dim LocalFilePath As String
Dim DownloadStatus As Long
strURL = "http://data.iana.org/TLD/tlds-alpha-by-domain.txt"
LocalFilePath = "C:\Test\TEST2_tlds-alpha-by-domain.txt"
DownloadStatus = URLDownloadToFile(0, strURL, LocalFilePath, 0, 0)
If DownloadStatus = 0 Then
MsgBox "File Downloaded. Check in this path: " & LocalFilePath
Else
MsgBox "Download File Process Failed"
End If
End Sub
Sub DownloadFile()
Dim WinHttpReq As Object
Dim oStream As Object
Dim myURL As String
Dim LocalFilePath As String
myURL = "http://data.iana.org/TLD/tlds-alpha-by-domain.txt"
LocalFilePath = "C:\Test\TEST_tlds-alpha-by-domain.txt"
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "", "" '("username", "password")
WinHttpReq.send
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile LocalFilePath, 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
End Sub

Related

how to save a downloaded excel file using vba

I made a simple VBA code that go to a link and download a Excel file, the link is an intermediate HTML page which then downloads the file, i just need to access, but now i need to save it. I am a noob at VBA, can anyone help me? Follow the code Bellow
Private pWebAddress As String
Public Declare PtrSafe Function ShellExecute _
Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Public Sub NewShell(cmdLine As String, lngWindowHndl As Long)
ShellExecute lngWindowHndl, "open", cmdLine, "", "", 1
End Sub
Public Sub WebPage()
Let pWebAddress = "https://imea.com.br/imea-site/arquivo-externo?categoria=relatorio-de-mercado&arquivo=cup-milho&numeropublicacao=4"
Call NewShell(pWebAddress, 3)
i Have already researched a lot, but none of the ones i have seen had be of help.
UPDATE
With the help of Tim, i sucessfully made the vba code, it was simple.
Dim wb As Workbook
Set wb = Workbooks.Open("PastTheLinkHere")
wb.SaveAs "PastTheDestinationHere"
wb.Close
End Sub
What i really needed was to make the link a direct link, and with help of Tim it was easy. Thank you Tim.
This URL:
https://imea.com.br/imea-site/arquivo-externo?categoria=relatorio-de-mercado&arquivo=cup-milho&numeropublicacao=4
leads to a page with this javascript which builds the final URL:
methods: {
laodMetadata() {
const urlParams = new URLSearchParams(window.location.search);
this.categoria = urlParams.get("categoria");
this.safra = urlParams.get("safra");
this.arquivo = urlParams.get("arquivo");
this.numeropublicacao = urlParams.get("numeropublicacao");
},
async loadData() {
this.loading = true;
const url = "https://publicacoes.imea.com.br";
this.url = url;
if (this.categoria != null)
this.url = this.url + `/${this.categoria}`;
if (this.safra != null) this.url = this.url + `/${this.safra}`;
if (this.arquivo != null) this.url = this.url + `/${this.arquivo}`;
if (this.numeropublicacao != null)
this.url = this.url + `/${this.numeropublicacao}`;
return this.url;
},
The final URL is then:
https://publicacoes.imea.com.br/relatorio-de-mercado/cup-milho/4
So this works and opens the Excel file directly in Excel:
Workbooks.Open "https://publicacoes.imea.com.br/relatorio-de-mercado/cup-milho/4"
You could translate that js into VBA to make a function which would translate the first URL into the second one.
Function tester()
Dim url As String
url = "https://imea.com.br/imea-site/arquivo-externo?" & _
"categoria=relatorio-de-mercado&arquivo=cup-milho&numeropublicacao=4"
Debug.Print MapToDownloadUrl(url)
End Function
Function MapToDownloadUrl(url As String) As String
Dim urlNew As String, dict As Object, e
Set dict = ParseQuerystring(url)
If dict Is Nothing Then Exit Function
urlNew = "https://publicacoes.imea.com.br"
For Each e In Array("categoria", "arquivo", "numeropublicacao")
If dict.exists(e) Then urlNew = urlNew & "/" & dict(e)
Next e
MapToDownloadUrl = urlNew
End Function
'Parse out the querystring parameters from a URL as a dictionary
Function ParseQuerystring(url) As Object
Dim dict As Object, arr, arrQs, e
arr = Split(url, "?")
If UBound(arr) > 0 Then
Set dict = CreateObject("scripting.dictionary")
dict.comparemode = 1 'case-insensitive
arrQs = Split(arr(1), "&")
For Each e In arrQs
If InStr(e, "=") > 0 Then
arr = Split(e, "=")
If UBound(arr) = 1 Then dict.Add arr(0), arr(1)
End If
Next e
Set ParseQuerystring = dict
End If
End Function

Open a file from network drive by clicking on a link - in Microsoft Access form

I have the below code to open a file location FOLDER, however I would like to open the file itself instead of folder location.
Can someone suggest what should I change in the code.
Private Sub File_locationButton_Click()
Dim filePath
filePath = File_Location
Shell "C:\WINDOWS\explorer.exe """ & filePath & "", vbNormalFocus
End Sub
You can use ShellExecute, so:
Private Sub File_locationButton_Click()
Dim filePath
filePath = File_Location
OpenDocumentFile filePath
End Sub
which calls:
Option Compare Database
Option Explicit
' API declarations for OpenDocumentFile.
' Documentation:
' https://learn.microsoft.com/en-us/windows/win32/api/shellapi/nf-shellapi-shellexecutea
'
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
Private Declare PtrSafe Function GetDesktopWindow Lib "USER32" () _
As Long
' ShowWindow constants (selection).
' Documentation:
' https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-showwindow
'
Private Const SwShowNormal As Long = 1
Private Const SwShowMinimized As Long = 2
Private Const SwShowMaximized As Long = 3
' Open a document file using its default viewer application.
' Optionally, the document can be opened minimised or maximised.
'
' Returns True if success, False if not.
' Will not raise an error if the path or file is not found.
'
' 2022-03-02. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function OpenDocumentFile( _
ByVal File As String, _
Optional ShowCommand As Long = SwShowNormal) _
As Boolean
Const OperationOpen As String = "open"
Const MinimumSuccess As Long = 32
' Shall not have a value for opening a document.
Const Parameters As String = ""
Dim Handle As Long
Dim Directory As String
Dim Instance As Long
Dim Success As Boolean
Handle = GetDesktopWindow
Directory = Environ("Temp")
Instance = ShellExecute(Handle, OperationOpen, File, Parameters, Directory, ShowCommand)
' If the function succeeds, it returns a value greater than MinimumSuccess.
Success = (Instance > MinimumSuccess)
OpenDocumentFile = Success
End Function

VBA scrape Table every cell

I am trying to scrape a table from a website that required logging on, inputting search option, before the table is even displayed. I managed to do the prior, however once the table is displayed I do not know how to get it onto my worksheet.
I have the table HTML location here:
IE.document.querySelector("[id='advanced_iframe']").contentDocument.querySelector("table[id=GridView1]")
and I can get the text from the table via:
IE.document.querySelector("[id='advanced_iframe']").contentDocument.querySelector("table[id=GridView1]").innerText
But I do not know how to get each cell of the table into every cell in my excel sheet ("Sheet1")
Table from the webpage:
Any help is appreaciated.
I can only assume you're using Windows and trying to run the VBA from inside Excel - you don't say otherwise, so here's the simplest solution that doesn't involve looping or dependencies of table format codes
You basically copy/paste the table into Excel using Excel's built in HTML translation tool and Microsoft's Clipboard
First - copy/paste Microsoft's Clipboard API functions into module
Option Explicit
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Public Sub SetClipboard(sUniText As String)
Dim iStrPtr As Long
Dim iLen As Long
Dim iLock As Long
Const GMEM_MOVEABLE As Long = &H2
Const GMEM_ZEROINIT As Long = &H40
Const CF_UNICODETEXT As Long = &HD
OpenClipboard 0&
EmptyClipboard
iLen = LenB(sUniText) + 2&
iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
iLock = GlobalLock(iStrPtr)
lstrcpy iLock, StrPtr(sUniText)
GlobalUnlock iStrPtr
SetClipboardData CF_UNICODETEXT, iStrPtr
CloseClipboard
End Sub
Public Function GetClipboard() As String
Dim iStrPtr As Long
Dim iLen As Long
Dim iLock As Long
Dim sUniText As String
Const CF_UNICODETEXT As Long = 13&
OpenClipboard 0&
If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
iStrPtr = GetClipboardData(CF_UNICODETEXT)
If iStrPtr Then
iLock = GlobalLock(iStrPtr)
iLen = GlobalSize(iStrPtr)
sUniText = String$(iLen \ 2& - 1&, vbNullChar)
lstrcpy StrPtr(sUniText), iLock
GlobalUnlock iStrPtr
End If
GetClipboard = sUniText
End If
CloseClipboard
End Function
Then change your line
IE.document.querySelector("[id='advanced_iframe']").contentDocument.querySelector("table[id=GridView1]").innerText
to assign it to a string variable using outerHTML to get TABLE markup
table_html = IE.document.querySelector("[id='advanced_iframe']").contentDocument.querySelector("table[id=GridView1]").outerHTML
And then copy the table_html to the clipboard, before pasting into your starting cell for your table
SetClipboard table_html
Worksheets("Sheet1").Activate
Range("A1").Select
ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, DisplayAsIcon:=False
Here's a tested working example:
Public Sub TestHTMLPaste()
On Error GoTo Err_TestHTMLPaste
Const SiteURL As String = "https://www.grapecity.com/controls/activereports/download-version-history"
Dim IE As Object
Dim BodyHTML As String
Dim FieldStart As Integer
Dim FieldEnd As Integer
Dim TableHTML As String
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Navigate SiteURL
Do While .Busy Or .ReadyState <> 4
DoEvents
Loop
BodyHTML = .document.body.innerhtml
Debug.Print BodyHTML
If InStr(BodyHTML, "<table class=""gctable"">") > 0 Then
Debug.Print "Found it"
TableHTML = .document.querySelector("table[class=gctable]").outerHTML
SetClipboard TableHTML
DoEvents
End If
.Quit
End With
DoEvents
If TableHTML <> "" Then
Worksheets("Sheet1").Activate
Range("A1").Select
ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, DisplayAsIcon:=False
DoEvents
Range("A1").Select
Else
MsgBox " No Table HTML found"
End If
Err_TestHTMLPaste:
Set IE = Nothing
End Sub

How to convert string to json vb.net

this is the code i have, dim sline from string to json, i have try it and search on google, but i havent done yet...
please help
Dim sURL As String
sURL = TextBox1.Text
Dim wrGETURL As WebRequest
wrGETURL = WebRequest.Create(sURL)
Dim myProxy As New WebProxy("myproxy", 80)
myProxy.BypassProxyOnLocal = True
wrGETURL.Proxy = myProxy
wrGETURL.Proxy = WebProxy.GetDefaultProxy()
Dim objStream As Stream
objStream = wrGETURL.GetResponse.GetResponseStream()
Dim objReader As New StreamReader(objStream)
Dim sLine As String = ""
Dim i As Integer = 0
Do While Not sLine Is Nothing
i += 1
sLine = objReader.ReadLine
If Not sLine Is Nothing Then
Console.WriteLine("{0}:{1}", i, sLine)
End If
Loop
Dim respon As Array = sLine.ToArray()
Console.ReadLine()
Console.WriteLine(respon("traceNo"))
Console.ReadLine()
i want to convert the Dim sline to json, how it possible?
Newtonsoft.JSON is a VERY handy NuGet to easy use JSON in VB.Net.
Seperate your lines into a List(Of Integer, String) (i,sLine)
and Serialize it with
Dim yourJSONString = JsonConvert.SerializeObject(yourList)

Show File Path in Access 2010 Form

I have a form in Access 2010 that allows the user to find an Excel file and map it so that it can easily be accessed from another form. The simplest way to explain it, I think, is with a picture:
The form has this On Load event:
Private Sub Form_Load()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sSQL As String
Dim sPath As String
Set db = CurrentDb
On Error GoTo Error_Handler
sPath = Application.CurrentProject.Path
sSQL = "Select Setting from tblBackendFiles where Code = 'SourceVerification'"
Set rs = db.OpenRecordset(sSQL)
Me.tVerificationPath = Nz(rs!Setting, "")
If Len(Me.tVerificationPath) = 0 Then
Me.tExcelPath = sPath
End If
Me.cmdAcceptPath.SetFocus
rs.Close
GoTo exit_sub
Error_Handler:
MsgBox Err.number & ": " & Err.Description, vbInformation + vbOKOnly, "Error!"
exit_sub:
Set rs = Nothing
Set db = Nothing
End Sub
What I want is to have the current path of the Excel file displayed in the textbox, which is currently unbound. I've looked around online but I'm having a hard time finding how to actually get the path to show up.
What would be the best way to do this? I'd prefer to do it without VBA if at all possible, but I'm not 100% opposed to it.
I have done this many times. You will have to create a form. On that form, place a textbox called "tbFile", another called "tbFileName" (which is invisible) and a button called "bBrowse".
Then, behind your form, put this:
Option Compare Database
Option Explicit
Private Sub bBrowse_Click()
On Error GoTo Err_bBrowse_Click
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
Me.tbHidden.SetFocus
' strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
' & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
' strFilter = "Access Files (*.mdb)" & vbNullChar & "*.mdb*"
strFilter = "All Files (*.*)" & vbNullChar & "*.*"
lngFlags = tscFNPathMustExist Or tscFNFileMustExist Or tscFNHideReadOnly
varFileName = tsGetFileFromUser( _
fOpenFile:=True, _
strFilter:=strFilter, _
rlngflags:=lngFlags, _
strInitialDir:="C:\Windows\", _
strDialogTitle:="Find File (Select The File And Click The Open Button)")
'remove the strInitialDir:="C:\Windows\", _ line if you do not want the Browser to open at a specific location
If IsNull(varFileName) Or varFileName = "" Then
Debug.Print "User pressed 'Cancel'."
Beep
MsgBox "File selection was canceled.", vbInformation
Exit Sub
Else
'Debug.Print varFileName
tbFile = varFileName
End If
Call ParseFileName
Exit_bBrowse_Click:
Exit Sub
Err_bBrowse_Click:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_bBrowse_Click
End Sub
Private Function ParseFileName()
On Error GoTo Err_ParseFileName
Dim sFullName As String
Dim sFilePathOnly As String
Dim sDrive As String
Dim sPath As String
Dim sLocation As String
Dim sFileName As String
sFullName = tbFile.Value
' Find the final "\" in the path.
sPath = sFullName
Do While Right$(sPath, 1) <> "\"
sPath = Left$(sPath, Len(sPath) - 1)
Loop
' Find the Drive.
sDrive = Left$(sFullName, InStr(sFullName, ":") + 1)
'tbDrive = sDrive
' Find the Location.
sLocation = Mid$(sPath, Len(sDrive) - 2)
'tbLocation = sLocation
' Find the Path.
sPath = Mid$(sPath, Len(sDrive) + 1)
'tbPath = sPath
' Find the file name.
sFileName = Mid$(sFullName, Len(sPath) + 4)
tbFileName = sFileName
Exit_ParseFileName:
Exit Function
Err_ParseFileName:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_ParseFileName
End Function
Then, create a new Module and paste this into it:
Option Compare Database
Option Explicit
Private Declare Function ts_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (tsFN As tsFileName) As Boolean
Private Declare Function ts_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (tsFN As tsFileName) As Boolean
Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Private Type tsFileName
lStructSize As Long
hwndOwner As Long
hInstance As Long
strFilter As String
strCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
strFile As String
nMaxFile As Long
strFileTitle As String
nMaxFileTitle As Long
strInitialDir As String
strTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
strDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
' Flag Constants
Public Const tscFNAllowMultiSelect = &H200
Public Const tscFNCreatePrompt = &H2000
Public Const tscFNExplorer = &H80000
Public Const tscFNExtensionDifferent = &H400
Public Const tscFNFileMustExist = &H1000
Public Const tscFNPathMustExist = &H800
Public Const tscFNNoValidate = &H100
Public Const tscFNHelpButton = &H10
Public Const tscFNHideReadOnly = &H4
Public Const tscFNLongNames = &H200000
Public Const tscFNNoLongNames = &H40000
Public Const tscFNNoChangeDir = &H8
Public Const tscFNReadOnly = &H1
Public Const tscFNOverwritePrompt = &H2
Public Const tscFNShareAware = &H4000
Public Const tscFNNoReadOnlyReturn = &H8000
Public Const tscFNNoDereferenceLinks = &H100000
Public Function tsGetFileFromUser( _
Optional ByRef rlngflags As Long = 0&, _
Optional ByVal strInitialDir As String = "", _
Optional ByVal strFilter As String = "All Files (*.*)" & vbNullChar & "*.*", _
Optional ByVal lngFilterIndex As Long = 1, _
Optional ByVal strDefaultExt As String = "", _
Optional ByVal strFileName As String = "", _
Optional ByVal strDialogTitle As String = "", _
Optional ByVal fOpenFile As Boolean = True) As Variant
On Error GoTo tsGetFileFromUser_Err
Dim tsFN As tsFileName
Dim strFileTitle As String
Dim fResult As Boolean
' Allocate string space for the returned strings.
strFileName = Left(strFileName & String(256, 0), 256)
strFileTitle = String(256, 0)
' Set up the data structure before you call the function
With tsFN
.lStructSize = Len(tsFN)
.hwndOwner = Application.hWndAccessApp
.strFilter = strFilter
.nFilterIndex = lngFilterIndex
.strFile = strFileName
.nMaxFile = Len(strFileName)
.strFileTitle = strFileTitle
.nMaxFileTitle = Len(strFileTitle)
.strTitle = strDialogTitle
.flags = rlngflags
.strDefExt = strDefaultExt
.strInitialDir = strInitialDir
.hInstance = 0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
.lpfnHook = 0
End With
' Call the function in the windows API
If fOpenFile Then
fResult = ts_apiGetOpenFileName(tsFN)
Else
fResult = ts_apiGetSaveFileName(tsFN)
End If
' If the function call was successful, return the FileName chosen
' by the user. Otherwise return null. Note, the CancelError property
' used by the ActiveX Common Dialog control is not needed. If the
' user presses Cancel, this function will return Null.
If fResult Then
rlngflags = tsFN.flags
tsGetFileFromUser = tsTrimNull(tsFN.strFile)
Else
tsGetFileFromUser = Null
End If
tsGetFileFromUser_End:
On Error GoTo 0
Exit Function
tsGetFileFromUser_Err:
Beep
MsgBox Err.Description, , "Error: " & Err.Number _
& " in function basBrowseFiles.tsGetFileFromUser"
Resume tsGetFileFromUser_End
End Function
' Trim Nulls from a string returned by an API call.
Private Function tsTrimNull(ByVal strItem As String) As String
On Error GoTo tsTrimNull_Err
Dim I As Integer
I = InStr(strItem, vbNullChar)
If I > 0 Then
tsTrimNull = Left(strItem, I - 1)
Else
tsTrimNull = strItem
End If
tsTrimNull_End:
On Error GoTo 0
Exit Function
tsTrimNull_Err:
Beep
MsgBox Err.Description, , "Error: " & Err.Number _
& " in function basBrowseFiles.tsTrimNull"
Resume tsTrimNull_End
End Function
Public Sub tsGetFileFromUserTest()
On Error GoTo tsGetFileFromUserTest_Err
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
' strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
' & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
strFilter = "All Files (*.*)" & vbNullChar & "*.*"
lngFlags = tscFNPathMustExist Or tscFNFileMustExist Or tscFNHideReadOnly
varFileName = tsGetFileFromUser( _
fOpenFile:=True, _
strFilter:=strFilter, _
rlngflags:=lngFlags, _
strDialogTitle:="GetFileFromUser Test (Please choose a file)")
If IsNull(varFileName) Then
Debug.Print "User pressed 'Cancel'."
Else
Debug.Print varFileName
'Forms![Form1]![Text1] = varFileName
End If
If varFileName <> "" Then MsgBox "You selected the '" & varFileName & "' file.", vbInformation
tsGetFileFromUserTest_End:
On Error GoTo 0
Exit Sub
tsGetFileFromUserTest_Err:
Beep
MsgBox Err.Description, , "Error: " & Err.Number _
& " in sub basBrowseFiles.tsGetFileFromUserTest"
Resume tsGetFileFromUserTest_End
End Sub
VOILA! Easy as that. ;o)