Category: Data Mining

SQL Azure – TSQL User Defined Function – Pull out Long Dates from NVARCHAR(MAX)

Dates that match the pattern 2 numbers a single space the month a single space then a 4 digit year this will be good for any dates following this format from 1000 AD to 9999AD with a NVARCHAR(MAX) field note it will only pick up the last date in a text field.

Sourced adapted and tested from Stack Overflow

*Please note the square brackets c square brackets string is being omitted for months containing the letter c (I believe it relates to html and the copyright symbol I can’t place it anywhere in my post). You will need to add it back in to those months that contain c. I have therefore replaced square brackets c square brackets with [k]

January

Create function [dbo].[m01returnjandates](@fieldtosearch as nvarchar(max))
 Returns nvarchar(15)
 as
 begin
 declare @length as int
 declare @loop as int
 declare @retjandate as date
 set @loop =1
 set @length = len(@fieldtosearch)
 
 while @loop<=@length-14
    begin
    if exists(select 1 where substring(@fieldtosearch,@loop,15) like '[0-9][0-9][ ][J][a][n][u][a][r][y][ ][0-9][0-9][0-9][0-9]')
        set @retjandate= substring(@fieldtosearch,@loop,15)
    set @loop=@loop+1
    end
Return @retjandate
End

===
February

Create function [dbo].[m02returnfebdates](@fieldtosearch as nvarchar(max))
 Returns nvarchar(16)
 as
 begin
 declare @length as int
 declare @loop as int
 declare @retfebdate as date
 set @loop =1
 set @length = len(@fieldtosearch)
 
 while @loop<=@length-15
    begin
    if exists(select 1 where substring(@fieldtosearch,@loop,16) like '[0-9][0-9][ ][F][e][b][r][u][a][r][y][ ][0-9][0-9][0-9][0-9]')
        set @retfebdate= substring(@fieldtosearch,@loop,16)
    set @loop=@loop+1
    end
Return @retfebdate
End

====
March

Create function [dbo].[m03returnmardates](@fieldtosearch as nvarchar(max))
 Returns nvarchar(13)
 as
 begin
 declare @length as int
 declare @loop as int
 declare @retmardate as date
 set @loop =1
 set @length = len(@fieldtosearch)
 
 while @loop<=@length-12
    begin
    if exists(select 1 where substring(@fieldtosearch,@loop,13) like '[0-9][0-9][ ][M][a][r][k][h][ ][0-9][0-9][0-9][0-9]')
        set @retmardate= substring(@fieldtosearch,@loop,13)
    set @loop=@loop+1
    end
Return @retmardate
End

===
April

Create function [dbo].[m04returnaprdates](@fieldtosearch as nvarchar(max))
 Returns nvarchar(13)
 as
 begin
 declare @length as int
 declare @loop as int
 declare @retaprdate as date
 set @loop =1
 set @length = len(@fieldtosearch)
 
 while @loop<=@length-12
    begin
    if exists(select 1 where substring(@fieldtosearch,@loop,13) like '[0-9][0-9][ ][A][p][r][i][l][ ][0-9][0-9][0-9][0-9]')
        set @retaprdate= substring(@fieldtosearch,@loop,13)
    set @loop=@loop+1
    end
Return @retaprdate
End

===
May

Create function [dbo].[m05returnmaydates](@fieldtosearch as nvarchar(max))
 Returns nvarchar(11)
 as
 begin
 declare @length as int
 declare @loop as int
 declare @retmaydate as date
 set @loop =1
 set @length = len(@fieldtosearch)
 
 while @loop<=@length-10
    begin
    if exists(select 1 where substring(@fieldtosearch,@loop,11) like '[0-9][0-9][ ][M][a][y][ ][0-9][0-9][0-9][0-9]')
        set @retmaydate= substring(@fieldtosearch,@loop,11)
    set @loop=@loop+1
    end
Return @retmaydate
End

===
June

Create function [dbo].[m06returnjundates](@fieldtosearch as nvarchar(max))
 Returns nvarchar(12)
 as
 begin
 declare @length as int
 declare @loop as int
 declare @retjundate as date
 set @loop =1
 set @length = len(@fieldtosearch)
 
 while @loop<=@length-11
    begin
    if exists(select 1 where substring(@fieldtosearch,@loop,12) like '[0-9][0-9][ ][J][u][n][e][ ][0-9][0-9][0-9][0-9]')
        set @retjundate= substring(@fieldtosearch,@loop,12)
    set @loop=@loop+1
    end
Return @retjundate
End

===
July

Create function [dbo].[m07returnjuldates](@fieldtosearch as nvarchar(max))
 Returns nvarchar(12)
 as
 begin
 declare @length as int
 declare @loop as int
 declare @retjuldate as date
 set @loop =1
 set @length = len(@fieldtosearch)
 
 while @loop<=@length-11
    begin
    if exists(select 1 where substring(@fieldtosearch,@loop,12) like '[0-9][0-9][ ][J][u][l][y][ ][0-9][0-9][0-9][0-9]')
        set @retjuldate= substring(@fieldtosearch,@loop,12)
    set @loop=@loop+1
    end
Return @retjuldate
End

===
August

Create function [dbo].[m08returnaugdates](@fieldtosearch as nvarchar(max))
 Returns nvarchar(14)
 as
 begin
 declare @length as int
 declare @loop as int
 declare @retaugdate as date
 set @loop =1
 set @length = len(@fieldtosearch)
 
 while @loop<=@length-13
    begin
    if exists(select 1 where substring(@fieldtosearch,@loop,14) like '[0-9][0-9][ ][A][u][g][u][s][t][ ][0-9][0-9][0-9][0-9]')
        set @retaugdate= substring(@fieldtosearch,@loop,14)
    set @loop=@loop+1
    end
Return @retaugdate
End

===
September

Create function [dbo].[m09returnsepdates](@fieldtosearch as nvarchar(max))
 Returns nvarchar(17)
 as
 begin
 declare @length as int
 declare @loop as int
 declare @retsepdate as date
 set @loop =1
 set @length = len(@fieldtosearch)
 
 while @loop<=@length-16
    begin
    if exists(select 1 where substring(@fieldtosearch,@loop,17) like '[0-9][0-9][ ][S][e][p][t][e][m][b][e][r][ ][0-9][0-9][0-9][0-9]')
        set @retsepdate= substring(@fieldtosearch,@loop,17)
    set @loop=@loop+1
    end
Return @retsepdate
End

===
October

Create function [dbo].[m10returnoctdates](@fieldtosearch as nvarchar(max))
 Returns nvarchar(15)
 as
 begin
 declare @length as int
 declare @loop as int
 declare @retjoctdate as date
 set @loop =1
 set @length = len(@fieldtosearch)
 
 while @loop<=@length-14
    begin
    if exists(select 1 where substring(@fieldtosearch,@loop,15) like '[0-9][0-9][ ][O][k][t][o][b][e][r][ ][0-9][0-9][0-9][0-9]')
        set @retoctdate= substring(@fieldtosearch,@loop,15)
    set @loop=@loop+1
    end
Return @retoctdate
End

===
November

Create function [dbo].[m11returnnovdates](@fieldtosearch as nvarchar(max))
 Returns nvarchar(16)
 as
 begin
 declare @length as int
 declare @loop as int
 declare @retnovdate as date
 set @loop =1
 set @length = len(@fieldtosearch)
 
 while @loop<=@length-15
    begin
    if exists(select 1 where substring(@fieldtosearch,@loop,16) like '[0-9][0-9][ ][N][o][v][e][m][b][e][r][ ][0-9][0-9][0-9][0-9]')
        set @retnovdate= substring(@fieldtosearch,@loop,16)
    set @loop=@loop+1
    end
Return @retnovdate
End

===
December

Create function [dbo].[m12returndecdates](@fieldtosearch as nvarchar(max))
 Returns nvarchar(16)
 as
 begin
 declare @length as int
 declare @loop as int
 declare @retdecdate as date
 set @loop =1
 set @length = len(@fieldtosearch)
 
 while @loop<=@length-15
    begin
    if exists(select 1 where substring(@fieldtosearch,@loop,16) like '[0-9][0-9][ ][D][e][k][e][m][b][e][r][ ][0-9][0-9][0-9][0-9]')
        set @retdecdate= substring(@fieldtosearch,@loop,16)
    set @loop=@loop+1
    end
Return @retdecdate
End

===
And the inefficent example TSQL

SELECT dbo.T032email.pkid,
ISNULL(dbo.m01returnjandates(dbo.T032email.body),
    ISNULL(dbo.m02returnfebdates(dbo.T032email.body),
        ISNULL(dbo.m03returnmardates(dbo.T032email.body),
            ISNull(dbo.m04returnaprdates(dbo.T032email.body), 
				ISNULL(dbo.m05returnmaydates(dbo.T032email.body),
					ISNULL(dbo.m06returnjundates(dbo.T032email.body),
					ISNULL(dbo.m07returnjuldates(dbo.T032email.body),
					ISNull(dbo.m08returnaugdates(dbo.T032email.body,					 
                                        ISNULL(dbo.m09returnsepdates(dbo.T032email.body),
					ISNULL(dbo.m10returnoctdates(dbo.T032email.body),
	ISNULL(dbo.m11returnnovdates(dbo.T032email.body), dbo.m12returndecdates(dbo.T032email.body)
				))))))))))) as trandate FROM T032email;

MS Access Function : Automate Normalisation or De-concatenate a field (MS Outlook export example)

I was contemplating a better way of storing our old emails and unhappy with some of the systems in place I started considering whether I could dump them into a database.

Thing is when you export from Outlook some of the standard fields in particular To and From are concatenated. Wouldn’t it be nice to separate those fields into their own table of names and addresses and reference them back to a main table of messages.

This is what I came up with.

For demonstrations purposes I will use two tables

t001parent
pkid - autonumber primary key
ccaddresses - memo or long text

and the child table

t002newchildren
pkid - autonumber primary key
ccaddress - string(150 should do it)
pkidt001 - number

and here is the blank second table

Next we create a user defined function

Public Function CreateChildTable()

    Dim db          As DAO.Database
    Dim rs          As DAO.Recordset
    Dim rsTarget    As DAO.Recordset

    Dim strSQL      As String
    Dim strField1   As String
    Dim strField2   As String
    Dim varData     As Variant
    Dim i           As Integer
    Dim intPKID     As Integer

    Set db = CurrentDb

    'Select all the ccaddresses from the parent table
    strSQL = "SELECT pkid,ccaddresses FROM t001parent"

    Set rsTarget = db.OpenRecordset("t002newchildren", dbOpenDynaset, dbAppendOnly)

    Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
    With rs
        While Not .EOF
            intPKID = !pkid
            varData = Split(!ccaddresses, ";") ' Get all semi colon delimited fields
               
            'add email addresses if there is only one email address there
            With rsTarget
            .AddNew
            !ccaddresss = Trim(varData(0)) ' remove spaces before writing new fields
            !pkidt001 = intPKID
            .Update
            End With
            

            'loop through addtional email addresses and add them as children to table
            For i = 1 To UBound(varData)
                With rsTarget
                    .AddNew
                    !ccaddresss = Trim(varData(i)) ' remove spaces before writing new fields
                    !pkidt001 = intPKID
                    .Update
                End With
            Next
            .MoveNext
        Wend

        .Close
        rsTarget.Close

    End With

    Set rsTarget = Nothing
    Set rs = Nothing
    db.Close
    Set db = Nothing

End Function

After running this we should

We’ve just nicely split the parent table ccaddesses field into constituent emails and normalised it as a child of the parent table.

MS Access Function : Print to excel spreadsheet field definitions of all tables in a database

This places all tables and fields into an excel file on a single worksheet as a single table.

Public Function TableDef()
Dim def As TableDef
Dim wb As Object
Dim xL As Object
Dim lngRow As Long
Dim f As Field
Set xL = CreateObject("Excel.Application")
xL.Visible = True
Set wb = xL.workbooks.Add
lngRow = 2
For Each def In CurrentDb.TableDefs
For Each f In def.Fields
With wb.sheets("Sheet1")
.Range("A" & lngRow).Value = def.Name
.Range("B" & lngRow).Value = f.Name
.Range("C" & lngRow).Value = f.Type
.Range("D" & lngRow).Value = f.Size
.Range("E" & lngRow).Value = f.Required
lngRow = lngRow + 1
End With
Next
Next
End Function

MS Access Function : Loop through tables and export to csv

A function that will loop through an access database and export all tables to csv and xls.

Useful for subsequent import through QGIS into Postgres.

Public Function ExportAll()
Dim obj As AccessObject, dbs As Object
Dim strFolder As String
strFolder = "c:\"
Set dbs = Application.CurrentData
For Each obj In dbs.AllTables
If Left(obj.Name, 4) <> "MSys" Then
DoCmd.TransferText acExportDelim, , obj.Name, strFolder & obj.Name & ".csv", True
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, obj.Name, strFolder & obj.Name & ".xls", True
End If
Next obj
End Function

MS Access – Code Snippets for Navigating using Internet Explorer

Waiting for a web page to load

While ie.Busy
DoEvents
Wend

Selecting differing radio buttons

Dim ieRadio As Object
Set ieRadio = ie.Document.all
ieRadio.Item("datetype")(1).Checked = True

A function that can be used to delay action before an action in code (Not web specific). Here I set to 1 second

Public Function Await1()
Dim time1 As Variant
Dim time2 As Variant

time1 = Now
time2 = Now + TimeValue("0:00:01")
    Do Until time1 >= time2
        DoEvents
        time1 = Now()
    Loop

End Function

Split a string of text into a 1 dimensional array with splitting occurring at returns.

Dim strArray() as String
Dim strtoParse as String
Dim intCount as Long

'here I taken an imaginary recordset and set the string to parse from the text value in the recordset
strtoParse = rs!Text
strArray = Split(strtoParse, vbNewLine)

'a simple loop that will count the number of values in the array (1 dimensional)
For intcount = LBound(strArray) To UBound(strArray)
      MsgBox Trim(strArray(intCount))
   Next

Find a string in an array note the complete string needs to be found not a part within one of the array parts.

Private Function WhereInArray(vArrayName As Variant, vStringtoFind As String) As Variant
Dim i As Long
For i = LBound(vArrayName) To UBound(vArrayName)
    If vArrayName(i) = vStringtoFind Then
        WhereInArray = i
        Exit Function
    End If
Next i
'if you get here, vStringtoFind was not in the array. Set to null
WhereInArray = Null
End Function

Show whats in which Array cell – where n is a number equal to the value of a cell
So eg strArray(60) would show the value in 60th cell note arrays start from 0

MsgBox strArray(n)

Copy the HTML of a web page to a variable

my_StrVariable = ie.Document.body.innerHTML

Filter out much of the HTML formatting and only put inner text into a variable

my_StrVariable = ie.Document.body.innerText

Replace with spaces with less spaces till 2 and 3 spaces are replaced by 1 space

Function ThreeTwo(ByVal parmString As String) As String
    Dim strTemp As String
    strTemp = parmString

    Do Until InStr(strTemp, "   ") = 0
        strTemp = Replace(strTemp, "   ", " ")
    Loop

    Do Until InStr(strTemp, "  ") = 0
        strTemp = Replace(strTemp, "  ", " ")
    Loop
    ThreeTwo = strTemp
End Function

Click on a button if all you know is its class name

Dim e
Set e = ie.Document.getElementsByClassName("button primary")(0)
e.Click

Identify sites and how often they are visited
labpix.online/rounduptheusualsuspects.org
Look at any site
http://labpix.online

Take a look at the robots.txt of a site
https://www.theregister.co.uk/robots.txt

https://www.ebay.co.uk/robots.txt