Who has locked my backend database ?

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

Advertisements

Currency Conversion / Exchange Rates in Access, Excel and VBA (using Yahoo Finance)

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 !!!

lion vs monkey

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

Typical Usage:
VBA:
dblRate = YahooCurrencyConverter(“USD”,”GBP”)

Excel can be used :
=YahooCurrencyConverter(A1,B1)
(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

How to trigger a Scheduled Task On Demand from a remote computer using VBA

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 :

mango_16x9[2]

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.

<QueryList>
<Query Id=”0″ Path=”Application”>
<Select Path=”Application”>*[System[Provider[@Name=’WSH’] and (EventID=4)]] and *[EventData[Data[1]=’CoconutTrigger’]]
</Select>
</Query>
</QueryList>

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://jpadda.wordpress.com/2010/08/08/event-log-write-permissions/
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
channelAccess: 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)

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.

Example :
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 !!!


Repairing Access VBA corruption using /decompile

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 style

Applies to Excel..

**** UPDATED 09/08/2018 ****
Google says that you now need an API key to make requests. An API key is a big long secret code which will identify you so that your searches can be linked to your Google Account.  If you don’t have a Google account then you will need one of those too.

They have also said calls must be made over SSL, i.e. https instead of http.

If you are an existing user (pre 9th Aug) and you have started to get weird and strange ACCESS DENIED errors or REQUEST DENIED errors then you may need to update your code.

To get an API key you need to follow the procedure outlined by Google here :

https://developers.google.com/maps/documentation/directions/get-api-key

Getting an API key is free, and with it you will have your free daily allowances as before.

I have updated the code below to include the key in the line that constructs the URL.

The which needs updateing is this one … 

strURL = "http://maps.googleapis.com/maps/api/directions/xml" & _
            "?origin=" & strStartLocation & _
            "&destination=" & strEndLocation & _
            "&sensor=false" & _
            "&units=" & strUnits 

Then, change http to https and add the API key parameter with your new key :

strURL = "https://maps.googleapis.com/maps/api/directions/xml" & _
            "?origin=" & strStartLocation & _
            "&destination=" & strEndLocation & _
            "&key=YOURAPIKEYHERE" & _
            "&sensor=false" & _
            "&units=" & strUnits 

That’s it.

**** 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…

getGoogleDistance(strFrom,strTo)
getGoogleTravelTime(strFrom,strTo)
getGoogleDirections(strFrom,strTo)

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, "")
   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 = "https://maps.googleapis.com/maps/api/directions/xml" & _
            "?origin=" & strStartLocation & _
            "&destination=" & strEndLocation & _
            "&key=YOURAPIKEYHERE" & _
            "&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.
sample.xls

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.
filltraveltimes.xls


**** 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 …

Coconut Dreams


How to extract the filename from a full path using VBA in Access or Excel. GetFileName without FileSystemObject.

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 :
FiftyShadesOfMango.doc

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

Template function to connect to Excel from Access using VBA automation.

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