Applies to : Microsoft Access, VBA
Sometimes in life, you need to compress your backend database. You ask everybody to log off and they do, but when you try to perform the compress it doesn’t let you because SOMEBODY is still logged in. Finding out who is not always easy.
First check yourself, quite often it’s you! if it’s not you and you are sure it’s not you, then it must be somebody else. Check the toilet, the kitchen, the stairs, the local pub or any other places that you might find roaming employees who may not have received the memo, it’s probably them.
Another quicker way, is to use this CheckDatabaseLocks function below which checks the server for ‘Open Files’ on the server of type Mdb, Accdb or Ldb and then tells you who has locked them.
You can call this procedure from any client database on any client computer. You don’t have to call it from the server but you will need to specify the server name as a parameter and I’m pretty sure you will need to be a domain administrator. The server name parameter is the name of the server where the share containing the backend data-database resides.
If the procedure runs successfully then you will be presented with a message box for each locked file, telling you which file is locked and who has locked it, you may wish to further improve how the information is presented.
'Example Usage : CheckDatabaseLocks "Server01" 'Detects which users are connected to the backend database (mdb,accdb,ldb) on a server. 'Where strServerName is the name of the server where the backend data resides. Sub CheckDatabaseLocks(ByVal strServerName) Dim objConnection As Object Dim colResources As Object Dim strPath As String Dim strUser As String Set objConnection = GetObject("WinNT://" & strServerName & "/LanManServer") Set colResources = objConnection.Resources For Each objResource In colResources strPath = "" strUser = "" strPath = Nz(objResource.Path, "") strUser = Nz(objResource.User, "") If (InStr(1, strPath, ".mdb") > 0) Or _ (InStr(1, strPath, ".ldb") > 0) Or _ (InStr(1, strPath, ".accdb") > 0) Then _ MsgBox strUser & " is using " & strPath End If Next End Sub
Ok, so this isn’t official, but here is how to do currency conversion in Excel, Access and VBA in general, using YAHOO finance. i.e. Get the current exchange rate for USD/GBP etc.
It’s a function that interrogates Yahoo finance services currency conversion system and returns the conversion rate.
I’ve not read their terms and conditions or whatever, but I suspect that using this function is not permitted. So, my recommendation is not to use this function under any circumstances what so ever!!!
But if you do use this function, and it means that you are doing good for people or helping someone, and generally making the world a better place.. then please consider this old ethnic proverb about the lion and the monkey :
“A monkey was protective over his banana’s, he would not share them with any of the other monkeys. Eventually, all the other monkeys died of starvation. The lion needed something to eat, the monkey said “have one of my banana’s, I have plenty!”. The lion ate the monkey.”
BANANAS ARE FOR EVERYONE !!!
Can be used in Access or Excel or any other VBA app to convert currency..
Typical currency codes are iso 2417 codes : eg: USD, EUR, GBP…
Currently (27/06/2014) there is a list here : http://www.xe.com/iso4217.php
dblRate = YahooCurrencyConverter(“USD”,”GBP”)
Excel can be used :
(where A1 and B1 contain respective currency codes)
CODE STARTS HERE :
Function YahooCurrencyConverter(ByVal strFromCurrency, ByVal strToCurrency, Optional ByVal strResultType = "Value") On Error GoTo ErrorHandler 'Init Dim strURL As String Dim objXMLHttp As Object Dim strRes As String, dblRes As Double Set objXMLHttp = CreateObject("MSXML2.ServerXMLHTTP") strURL = "http://finance.yahoo.com/d/quotes.csv?e=.csv&f=c4l1&s=" & strFromCurrency & strToCurrency & "=X" 'Send XML request With objXMLHttp .Open "GET", strURL, False .setRequestHeader "Content-Type", "application/x-www-form-URLEncoded" .Send strRes = .ResponseText End With 'Parse response dblRes = Val(Split(strRes, ",")(1)) Select Case strResultType Case "Value": YahooCurrencyConverter = dblRes Case Else: YahooCurrencyConverter = "1 " & strFromCurrency & " = " & dblRes & " " & strToCurrency End Select CleanExit: Set objXMLHttp = Nothing Exit Function ErrorHandler: YahooCurrencyConverter = 0 GoTo CleanExit End Function
THIS IS DESMOND OSHIWAMBO GOLD. UNIQUE AND ORIGINAL, HOT OFF THE PRESS !!
How to trigger a Scheduled Task On Demand from a remote computer using VBA.
This post is NEW : If you find it useful or have any questions then please let me know. This post requires a reasonable level of competence, if you don’t know about Scheduled Tasks/Event Viewer/Command Prompts/Run as Administrator then perhaps this post is not for you, sorry !
Also, if you are looking for a PSEXEC solution, this post is not for you; but PSEXEC is a valid alternative.
Also, the command line tool SchTasks can be used by administrators to manage tasks locally and remotely, but as this requires administrative privileges it is not usually good enough.
The Oshiwambo way (below) shows how to trigger an event into a remote computers application log, the remote computers application log then recognises the event and processes a scheduled task. If this is what you are looking for, then read on …
Solution begins after a juicy Mango :
Hello, in case you do not know me, my name is Desmond Oshiwambo.
I love to sit on the beach surfing the web on my laptop, looking out at the waves and contemplating my dry feet. I am connected to my beach-hut via WI-FI, and my beach-hut has a scheduled task that updates the weather twice daily. Occasionally, it would be nice to force that scheduled task from my laptop by the sea, without having to wait for the time of day to reach that rightful hour. So, how do I call a scheduled task on demand ? Well, let us go coconut crazy and find out !!….
First of all, you should really know about the Event Viewer in Control Panel, and about Scheduled Tasks. Also, a fair degree of awesomeness and confidence is required to go ahead with this method, it is not for the feint hearted ! If it any point you feel scared (and perhaps you should when modifying the permissions of your Event Logs) read the links that I have provided, study hard and you will get there; it’s not as difficult as it looks !!
Ok, so you’re brave and confident and mango’d up to the eyebrows… let’s go..
There are 3 basic steps.
1. Create a scheduled task, instead of using a time trigger, use an Event Log trigger. This runs the scheduled task when a specific Event happens in the computers Event Log (accessible via Control Panel)
2. Modify the Events Log (control panel) Application Log security to allow all Domain Users to alter the log. In secure environments please consider the security implications of this, but my beach hut is fine !!
3. Call the event from a remote computer using WShell->LogEvent method.
It’s all quite simple when you know how …
1. Create The Scheduled Task.
Create your scheduled task with adequate permissions etc.
Triggers -> Begin Task -> On An Event -> Select Custom (instead of Basic) -> Press New Event Filter -> Select the XML tab across the top.
Insert the following XML, replace the text ‘CoconutTrigger’ with the name of your trigger. This is the details of the Event that will appear in the Application Event Log that you want to use as a trigger.
<Query Id=”0″ Path=”Application”>
<Select Path=”Application”>*[System[Provider[@Name=’WSH’] and (EventID=4)]] and *[EventData[Data=’CoconutTrigger’]]
Continue setting up your scheduled task as you like it, with all the necessary actions and permission etc.
2. Modify Events Log permissions.
The events log can only really be looked at and modified by Administrators of the local computer. This solution requires you to relax this rule and allow other members of your Domain to make modifications too. If you work at GCHQ or the NSA then perhaps this is not an option, but here on my beach the security implications of allowing another computer to the access the logs of my local computer are negligible. Anyway, it’s a requirement of this solution.
Modifying the Event Logs permissions should be simple, but it is not. In fact, it is voodooly complicated.
I will explain how, but know that I gleaned my information from the following resources, which may assist you if you are having difficulties.
http://www.netid.washington.edu/documentation/domains/sddl.aspx (SDDL Link)
Open up a Command prompt (Start Run-> cmd) with admin privileges (Run As Admin).
To output the permissions of your EventLogs as a text file c:\out.txt type :
c:\wevtutil gl application > C:\out.txt
(The gl parameter of wevtutil outputs the security permissions)
Edit the file with notepad to get the Channel Access line. It will look something like this
The Goblidegook represents security permissions for the Application Log. Each set of brackets represents a specific security rule. See http://www.netid.washington.edu/documentation/domains/sddl.aspx)
The string starting O:BAG…. etc, needs the following permission appending to the end of it it (A;;0×3;;;DU)
n.b. (DU – means Domain Users)
To update the security settings you must use wevtutil tool again this time using the sl parameter – to save the settings.
You must be extremely careful using this command (use copy and paste if you can), the O:Bag string must be the same as the channelAccess string above but with (A;;0×3;;;DU) at the end.
WARNING : DO NOT USE THE LINE OF CODE BELOW DIRECTLY — MAKE SURE YOU UPDATE THE O:BAG line WITH THE EQUIVALNET GOBLEDIGOOK FROM YOUR OWN c:\Out.txt FILE.
C:\wevtutil sl Application /ca:O:BAG:SYD:(A;;0xf0007;;;SY)(A;;0×7;;;BA)(A;;0×7;;;SO)(A;;0×3;;;IU)(A;;0×3;;;SU)(A;;0×3;;;S-1-5-3)(A;;0×3;;;S-1-5-33)(A;;0×1;;;S-1-5-32-573)(A;;0×3;;;DU)
If all has gone well, which I hope it has, you should get a Success message. If so then great! the lion is dead, the witch has melted and the wardrobe is wide open, Welcome to Narnia!
3. Finally, create a trigger !
The following code can be run from any computer in the domain. It triggers an event to be created on the remote computer in the Application Log – which then triggers the Scheduled Task on the computer (created in step 1).
This code can be called from VBA/Access, Excel or VB Script – where ‘CoconutTrigger’ is the data in the event that will cause the trigger (as per step 1).
And “\\remotePC” is the name of the PC on the network. This could be replaced by the name of the PC on the network or its local IP address.
Const EVENT_INFO = 4
Set objShell = Wscript.CreateObject(“Wscript.Shell”)
objShell.LogEvent EVENT_INFO, “CoconutTrigger” , “\\remotepc”
Set objShell = nothing
The event in the remote Application Log appears as WSH – Information – with ‘CoconutTrigger’ in the details.
Well, that took a lot to explain, but should really take about 8 minutes or so once you’ve done it a couple of times, it’s like peeling a mango!
Once you’re done, shoes and sandles off, let’s hit the WAVES !
Have Fun !!!
Sometimes, on a really bad day, Access does something really bad to your database so that when you try to modify or save a module, it crashes. You try Compacting and Repairing it again and again, but it remains broken !
If you don’t know what else to try, and have never heard of the /decompile parameter, then here is a ray of sunshine which may help to save your vbacon.
/decompile is an commandline parameter of MSACCESS.EXE that completely re-compiles your VBA code and fixes VBA anomolies.
It’s an un-documented function so use it sparingly and BACKUP FIRST.
Open your database from Start->Run :
“C:\Program Files (x86)\Microsoft Office\Office14\MSACCESS.EXE” “c:\YourDBPath\YourDBName.mdb” /decompile
(correcting the office path for the version you are using)
then run a compact/repair.
This may or may not fix your problem, but definitely worth a try !!
How to get Google Travel Time and Distance in VBA by using Google Directions API … Desmond Oshiwambo stylePosted: June 20, 2013
Applies to Access and Excel..
**** UPDATED 02/10/2015 !!!! New Sample sheet available, Fill Travel Times (with Via’s) see below ! ****
Original Post :
The following 3 functions are useful at the end of it all…
Please note : If you are having missing line-break/carriage return issues when copying and pasting this code, please try pasting it into Microsoft Word or Wordpad first. Then copying it from there into your VBA editor – doing this seems to preserve the linebreaks. This problem is an unresolved issue with the SyntaxHighlighting system that is bundled with WordPress — unresolved by me at least !
MODULE STARTS HERE :
' Usage : ' GetGoogleTravelTime (strFrom, strTo) returns a string containing journey duration : hh:mm ' GetGoogleDistance (strFrom, strTo) returns a string containing journey distance in either miles or km (as defined by strUnits) ' GetGoogleDirections (strFrom, strTo) returns a string containing the directions ' ' where strFrom/To are address search terms recognisable by Google ' i.e. Postcode, address etc. ' ' by Desmond Oshiwambo Const strUnits = "imperial" ' imperial/metric (miles/km) Function CleanHTML(ByVal strHTML) 'Helper function to clean HTML instructions Dim strInstrArr1() As String Dim strInstrArr2() As String Dim s As Integer strInstrArr1 = Split(strHTML, "<") For s = LBound(strInstrArr1) To UBound(strInstrArr1) strInstrArr2 = Split(strInstrArr1(s), ">") If UBound(strInstrArr2) > 0 Then strInstrArr1(s) = strInstrArr2(1) Else strInstrArr1(s) = strInstrArr2(0) End If Next CleanHTML = Join(strInstrArr1) End Function Public Function formatGoogleTime(ByVal lngSeconds As Double) 'Helper function. Google returns the time in seconds, so this converts it into time format hh:mm Dim lngMinutes As Long Dim lngHours As Long lngMinutes = Fix(lngSeconds / 60) lngHours = Fix(lngMinutes / 60) lngMinutes = lngMinutes - (lngHours * 60) formatGoogleTime = Format(lngHours, "00") & ":" & Format(lngMinutes, "00") End Function Function gglDirectionsResponse(ByVal strStartLocation, ByVal strEndLocation, ByRef strTravelTime, ByRef strDistance, ByRef strInstructions, Optional ByRef strError = "") As Boolean On Error GoTo errorHandler ' Helper function to request and process XML generated by Google Maps. Dim strURL As String Dim objXMLHttp As Object Dim objDOMDocument As Object Dim nodeRoute As Object Dim lngDistance As Long Set objXMLHttp = CreateObject("MSXML2.XMLHTTP") Set objDOMDocument = CreateObject("MSXML2.DOMDocument.6.0") strStartLocation = Replace(strStartLocation, " ", "+") strEndLocation = Replace(strEndLocation, " ", "+") strURL = "http://maps.googleapis.com/maps/api/directions/xml" & _ "?origin=" & strStartLocation & _ "&destination=" & strEndLocation & _ "&sensor=false" & _ "&units=" & strUnits 'Sensor field is required by google and indicates whether a Geo-sensor is being used by the device making the request 'Send XML request With objXMLHttp .Open "GET", strURL, False .setRequestHeader "Content-Type", "application/x-www-form-URLEncoded" .Send objDOMDocument.LoadXML .ResponseText End With With objDOMDocument If .SelectSingleNode("//status").Text = "OK" Then 'Get Distance lngDistance = .SelectSingleNode("/DirectionsResponse/route/leg/distance/value").Text ' Retrieves distance in meters Select Case strUnits Case "imperial": strDistance = Round(lngDistance * 0.00062137, 1) 'Convert meters to miles Case "metric": strDistance = Round(lngDistance / 1000, 1) 'Convert meters to miles End Select 'Get Travel Time strTravelTime = .SelectSingleNode("/DirectionsResponse/route/leg/duration/value").Text 'returns in seconds from google strTravelTime = formatGoogleTime(strTravelTime) 'converts seconds to hh:mm 'Get Directions For Each nodeRoute In .SelectSingleNode("//route/leg").ChildNodes If nodeRoute.BaseName = "step" Then strInstructions = strInstructions & nodeRoute.SelectSingleNode("html_instructions").Text & " - " & nodeRoute.SelectSingleNode("distance/text").Text & vbCrLf End If Next strInstructions = CleanHTML(strInstructions) 'Removes MetaTag information from HTML result to convert to plain text. Else strError = .SelectSingleNode("//status").Text GoTo errorHandler End If End With gglDirectionsResponse = True GoTo CleanExit errorHandler: If strError = "" Then strError = Err.Description strDistance = -1 strTravelTime = "00:00" strInstructions = "" gglDirectionsResponse = False CleanExit: Set objDOMDocument = Nothing Set objXMLHttp = Nothing End Function Function getGoogleTravelTime(ByVal strFrom, ByVal strTo) As String 'Returns the journey time between strFrom and strTo Dim strTravelTime As String Dim strDistance As String Dim strInstructions As String Dim strError As String If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then getGoogleTravelTime = strTravelTime Else getGoogleTravelTime = strError End If End Function Function getGoogleDistance(ByVal strFrom, ByVal strTo) As String 'Returns the distance between strFrom and strTo 'where strFrom/To are address search terms recognisable by Google 'i.e. Postcode, address etc. Dim strTravelTime As String Dim strDistance As String Dim strError As String Dim strInstructions As String If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then getGoogleDistance = strDistance Else getGoogleDistance = strError End If End Function Function getGoogleDirections(ByVal strFrom, ByVal strTo) As String 'Returns the directions between strFrom and strTo 'where strFrom/To are address search terms recognisable by Google 'i.e. Postcode, address etc. Dim strTravelTime As String Dim strDistance As String Dim strError As String Dim strInstructions As String If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then getGoogleDirections = strInstructions Else getGoogleDirections = strError End If End Function
SAMPLE SPREADSHEETS :
Here are some examples of the code in action.
To view the code behind the modules, open the spreadsheet and press Alt and F11 to view the Visual Basic window.
Download fully working example Excel spreadsheet here. The following example uses an in cell function call to perform the calculation.
This extra sample (uploaded 25/June/2014) contains a macro ‘FillTravelTimes’ which can efficiently process lists of multiple lookups and avoids the Google Overload problem.
**** LATEST ! UPDATED – 04/Dec/2015 ****
Fill Travel Times (with Via’s) (ver 2.0)
The following spreadsheet is an enhanced version of FillTravelTimes with GoogleOverload protection and the ability to efficiently calculate total TravelTimes and Distances with Via points, either with a | delimited list of addresses/postcodes, or by a range of cells.
DOWNLOAD HERE : GoogleTravelWithViaV2
Good Luck !!!!
Now it’s time for a refreshing coconut …
How to extract the filename from a full path using VBA in Access or Excel. GetFileName without FileSystemObject.Posted: June 17, 2013
Applies to : VBA Access and VBA Excel
Here is a nice little function called GetFileName that can be used to extract a filename from a path .. for example :
?GetFileName(“C:\My Documents\Desmond Oshiwambo\FiftyShadesOfMango.doc”)
Returns the string :
There are many ways to crack a coconut, but here is mine ! It uses the strReverse function to reverse the path, then uses the Split function to parse the reversed string for the first instance of “\”, then reverses it back. Nifty.
Function GetFileName(ByVal strPath As String) As String If strPath <> "" then GetFileName = StrReverse(Split(StrReverse(strPath), "\")(0)) End Function
This template function creates an instance of Excel (xlApp) , creates a new workbook (xlWB), and sets a xlWS to point at the first worksheet.
It then does not very much (because this is only a template function) and then closes the workbook and destroys the objects.
(Uses late-binding so no References required).
Function ExcelTemplateFunction() On Error GoTo ErrorHandler Dim xlApp As Object Dim xlWB As Object Dim xlWS As Object Set xlApp = CreateObject("Excel.Application") Set xlWB = xlApp.Workbooks.Add Set xlWS = xlWB.Worksheets(1) With xlWS Debug.Print .Name & " -- do something" End With 'Show Excel xlApp.Visible = True ExcelTemplateFunction = True GoTo CleanExit ErrorHandler: Debug.Print Err.Description ExcelTemplateFunction = False CleanExit: 'Close Excel - do not save If Not (xlWB Is Nothing) Then xlWB.Close False 'Close workbook (don't save) If Not (xlApp Is Nothing) Then xlApp.Quit 'Quit 'Destroy objects Set xlApp = Nothing Set xlWB = Nothing Set xlWS = Nothing End Function