Posting Invoices into Sage Line 50 from an Access Database

Sage Line 50 allows direct read/write access to many of the tables in Sage through the Sage Data Objects. To use this you will need to have the file sd0engxx0.tlb where xx is the sage version number.

2 keys issues I have had in loading data into sage

1. Ensure the values passed to Sage are not null, convert your values to strings where appropriate
2. The values passed to Sage are not longer than the field width

Sounds obvious but I missed both of these in earlier program versions.

The following Sample shows an invoice been posted from an access table to Sage.

Function fncCreateInvoices(ByVal tmpDate As Date)

On Error GoTo Error_Handler

'i use the date passed to filter the invoice table from MASC
If Not IsDate(tmpDate) Then
    MsgBox "Please enter a valid date"
    Exit Function
End If

DoCmd.Hourglass True

' Declare Objects
Dim oSDO As SageDataObject120.SDOEngine
Dim oWS As SageDataObject120.Workspace
Dim oInvoicePost As SageDataObject120.InvoicePost
Dim oInvoiceItem As SageDataObject120.InvoiceItem
Dim oSalesRecord As SageDataObject120.SalesRecord
Dim oStockRecord As SageDataObject120.StockRecord
Dim oSalesDeliveryRecord As SageDataObject120.SalesDeliveryRecord

Dim db As Database
Dim rstSource As Recordset, rstTrans As Recordset, strAccount
Dim tmpTranCust, tmpUseON As Boolean, tmpTranDD As String, tmpUseCPO As Boolean

Set db = CurrentDb

' Declare Variables
Dim strDataPath As String
Dim bFlag As Boolean
Dim iCtr As Integer

'sage initialise
' Create the SDO Engine Object
Set oSDO = New SageDataObject120.SDOEngine

' Create the Workspace
Set oWS = oSDO.Workspaces.Add("Example")

'Check that the selected invoices have a customer record See older posts for Actdate
Set rstSource = db.OpenRecordset("select * from QryCheckInvDates where tDate<=#" & ActDate(tmpDate) & "#")
Application.Echo True, "Checking Customers"
If rstSource.RecordCount > 0 Then
  If MsgBox("Some customer records are missing in sage, print a listing ?", vbYesNo) = vbYes Then
      DoCmd.OpenReport "rptMissingCustomers", acViewPreview
      GoTo Exit_Function
      MsgBox "Add the new customers to proceed"
      GoTo Exit_Function
  End If
End If
Application.Echo True, "Checking for Invoices to Add"
' create export code
Set rstSource = db.OpenRecordset("select * from qryInvoicestoExport where Value>0 and tDate<=#" & ActDate(tmpDate) & "# ORDER by Ref ASC")
If rstSource.RecordCount = 0 Then
      MsgBox "Nothing to process"
      GoTo Exit_Function
End If

Application.Echo True, "Checking for Sage Preferences to Add"

If ChkPrefs = False Then
    GoTo Exit_Function
End If

' Connect to Data Files
oWS.Connect "Line50 Directory","Login Name","Login Password", "Example"

Application.Echo True, "Connected to Sage"

'loop the record source
Do While Not rstSource.EOF

' Create an instance of InvoicePost & Record object's
 Set oSalesRecord = oWS.CreateObject("SalesRecord")
 Set oInvoicePost = oWS.CreateObject("InvoicePost")
 Set oStockRecord = oWS.CreateObject("StockRecord")

 ' Set the type of invoice for the next available number
 oInvoicePost.Type = sdoLedgerInvoice

 'get the transactions
 Set rstTrans = db.OpenRecordset("Select * from qryTrans Where hInvoiceno=" & rstSource!REF)
 If rstTrans.RecordCount = 0 Then
   MsgBox "No Transactions for invoice " & rstSource!REF
   GoTo loop_routine
 End If

 Application.Echo True, "Processing Invoice " & rstSource!REF

 ' Use the invoice number assigned from masc
 oInvoicePost.Header("Invoice_Number") = rstSource!REF

 ' Loop for Number of Items on the Invoice
       iCtr = 0
       tmpTranCust = ""
       Do While Not rstTrans.EOF

           Set oInvoiceItem = oInvoicePost.Items.Add()
         iCtr = iCtr + 1

         ' Initialise Index Field with value to search
         oStockRecord("Stock_CODE") = CStr(rstTrans!HprodC)
         If oSalesRecord.Find(False) Then
           oInvoiceItem("Stock_Code") = CStr(oStockRecord("Stock_Code"))
           oInvoiceItem("Description") = nullCstr(rstTrans!HInvText)
           oInvoiceItem("Comment_1") = nullCstr(rstTrans!HInvText)
           oInvoiceItem("Nominal_Code") = CStr(oStockRecord("Nominal_Code"))
           oInvoiceItem("Tax_Code") = CInt(Right(rstTrans!HVatRate, 1))
           oInvoiceItem("Stock_Code") = CStr(rstTrans!HprodC)
           oInvoiceItem("Description") = nullCstr(rstTrans!HInvText)
           oInvoiceItem("Comment_1") = nullCstr(rstTrans!HInvText)
           oInvoiceItem("Nominal_Code") = CStr(GetPref("Default Sales Nominal"))
           oInvoiceItem("Tax_Code") = CInt(Right(rstTrans!HVatRate, 1))
         End If

         ' Populate other fields required for Invoice Item
         oInvoiceItem("Qty_Order") = CDbl(rstTrans!HQty)
         oInvoiceItem("Unit_Price") = CDbl(rstTrans!HPrice)
         oInvoiceItem("Net_Amount") = CDbl(rstTrans!HLineValue)
         oInvoiceItem("Tax_Amount") = CDbl(rstTrans!HVatVal)
         oInvoiceItem("Comment_2") = CStr("Date:" & Format(rstTrans!HDATE, "dd/mm/yy"))
         oInvoiceItem("Unit_Of_Sale") = CStr("")
         oInvoiceItem("Full_Net_Amount") = CDbl(rstTrans!HVatVal + rstTrans!HLineValue)
         oInvoiceItem("Tax_Rate") = CDbl(rstTrans!VT_Rate)
         tmpTranCust = rstTrans!HCustCode
         tmpTranDD = nullCstr(rstTrans!HSuppref)
      Loop ' on trans

 ' Populate Invoice Header Information
 oInvoicePost.Header("Invoice_Date") = CDate(rstSource!TDate)
 oInvoicePost.Header("Notes_1") = CStr("")
 oInvoicePost.Header("Notes_2") = CStr("")
 oInvoicePost.Header("Notes_3") = CStr("")
 oInvoicePost.Header("Taken_By") = CStr("")
 oInvoicePost.Header("Order_Number") = IIf(tmpUseON, Left(CStr(tmpTranDD), 7), "")
 oInvoicePost.Header("Cust_Order_Number") = IIf(tmpUseCPO, Left(CStr(tmpTranDD), 7), "")
 oInvoicePost.Header("Payment_Ref") = CStr("")
 oInvoicePost.Header("Global_Nom_Code") = CStr("")
 oInvoicePost.Header("Global_Details") = CStr("")
 oInvoicePost.Header("Invoice_Type_Code") = CByte(sdoProductInvoice)
 oInvoicePost.Header("Items_Net") = CDbl(rstSource!InvNet)
 oInvoicePost.Header("Items_Tax") = CDbl(rstSource!InvVat)

 ' Read the first customer
 strAccount = CStr(rstSource!ID)
 strAccount = strAccount & String(8 - Len(strAccount), 32)
 oSalesRecord("Account_Ref") = strAccount

 bFlag = oSalesRecord.Find(False) '("ACCOUNT_REF", strAccount)
 If bFlag Then
 oInvoicePost.Header("Account_Ref") = CStr(rstSource!ID) 'oSalesRecord("Account_Ref"))
 oInvoicePost.Header("Name") = CStr(oSalesRecord("Name"))
 oInvoicePost.Header("Address_1") = CStr(oSalesRecord("Address_1"))
 oInvoicePost.Header("Address_2") = CStr(oSalesRecord("Address_2"))
 oInvoicePost.Header("Address_3") = CStr(oSalesRecord("Address_3"))
 oInvoicePost.Header("Address_4") = CStr(oSalesRecord("Address_4"))
 oInvoicePost.Header("Address_5") = CStr(oSalesRecord("Address_5"))
 Set oSalesDeliveryRecord = oWS.CreateObject("SalesDeliveryRecord")
 Dim bEnd
 bEnd = False
 If Not IsNull(tmpTranCust) Or Len(tmpTranCust) <> 0 Then
       If oSalesDeliveryRecord("DESCRIPTION") = tmpTranCust Then
         bEnd = True
         oInvoicePost.Header("DELIVERY_NAME") = CStr(oSalesDeliveryRecord("NAME"))
         oInvoicePost.Header("Del_Address_1") = CStr(oSalesDeliveryRecord("Address_1"))
         oInvoicePost.Header("Del_Address_2") = CStr(oSalesDeliveryRecord("Address_2"))
         oInvoicePost.Header("Del_Address_3") = CStr(oSalesDeliveryRecord("Address_3"))
         oInvoicePost.Header("Del_Address_4") = CStr(oSalesDeliveryRecord("Address_4"))
         oInvoicePost.Header("Del_Address_5") = CStr(oSalesDeliveryRecord("Address_5"))
         oInvoicePost.Header("Cust_Tel_Number") = CStr(oSalesDeliveryRecord("Telephone"))
         oInvoicePost.Header("Contact_Name") = CStr(oSalesDeliveryRecord("Contact_Name"))
       End If
   Loop Until (bEnd Or Not oSalesDeliveryRecord.MoveNext)

End If
End If
 ' Update the Invoice
 bFlag = oInvoicePost.Update
 If bFlag Then
   Application.Echo True, "Invoice Created Successfully :" & rstSource!REF
   db.Execute ("Update tblbillings set ar_PRocessed=-1 where ref=" & rstSource!REF)
   Application.Echo True, "Invoice Not Created"
 End If


Set oSalesRecord = Nothing
Set oInvoicePost = Nothing
Set oInvoiceItem = Nothing
Set oSalesDeliveryRecord = Nothing

Loop ' on rstsource


' Disconnect and Destroy Objects
Set oSDO = Nothing
Set oWS = Nothing
Set db = Nothing
Set rstSource = Nothing
Set rstTrans = Nothing

DoCmd.Hourglass False

Exit Function
' Error Handling Code
Call SageError(oSDO.LastError.Code, oSDO.LastError.Text, Err.Number, Err.Description, "Sage Invoice Export")

DoCmd.Hourglass False
Resume Exit_Function

End Function

Downloading Customer data from Intact Business Accounting

Intact Business Accounting has an SDK which is exposed for all developers and available in the system.  The following sample shows how we load the customer data into an Access database for use with our MASC Product. IF you are using Intact and have any questions leave me a comment and I will reply.

Function LoadCust()
On Error GoTo Intact_Error
Dim IntactTable As New INTACTSDKTable
Dim tmpLastRecord, r, tmpCount, tmpCompany, tmpRcode

tmpRcode = GetPref("RouteCode Field Name")

Application.Echo True, "Linking to selected Intact Company"

tmpCompany = GetPref("Intact Company")
IntactTable.CompanyDirectory (tmpCompany)
IntactTable.TableName ("CUSTS")

'Clear customers and set reference to table
CurrentDb.Execute ("Delete * from tblCustomers")
CurrentDb.Execute ("Delete * from tblCustMemo")
Dim rstCust As Recordset
Set rstCust = CurrentDb.OpenRecordset("tblCustomers")

r = IntactTable.First
tmpLastRecord = True
tmpCount = 1

    'Assign details
    rstCust!ID = IntactTable.fieldvalueasstring("CODE")
    Application.Echo True, "Adding Customer Seq:" & tmpCount & " :" & IntactTable.fieldvalueasstring("CODE")
    tmpCount = tmpCount + 1
    rstCust!CustBarcode = IntactTable.fieldvalueasstring("CODE")
    rstCust!CompanyName = IntactTable.fieldvalueasstring("NAME")
    rstCust!Add1 = IntactTable.fieldvalueasstring("ADR1")
    rstCust!Add2 = IntactTable.fieldvalueasstring("ADR2")
    rstCust!Add3 = IntactTable.fieldvalueasstring("ADR3")
    rstCust!Town = IntactTable.fieldvalueasstring("ADR4")
    rstCust!County = IntactTable.fieldvalueasstring("ADR5")
    rstCust!Phone = IntactTable.fieldvalueasstring("PHONE1")    
    rstCust!CPriceCode = IIf(Len(IntactTable.fieldvalueasstring("LISTCODE") & "") = 0, IntactTable.fieldvalueasstring("CODE"), IntactTable.fieldvalueasstring("LISTCODE"))
    'Check Delivery Address
    If Len(IntactTable.fieldvalueasstring("HOCODE") & "") > 0 Then
        rstCust!MasterAccount = IntactTable.fieldvalueasstring("HOCODE")
        rstCust!DeliveryAddress = -1
        rstCust!DeliveryAddress = 0
    End If
    rstCust!RouteCode = IntactTable.fieldvalueasstring("Repcode") 'tmpRcode) 'repcode
    'Frequency Check
    If Len(IntactTable.fieldvalueasstring("XXFREQ") & "") <> 0 And IntactTable.fieldvalueasstring("XXFREQ") <> "INVALID" Then
        rstCust!Frequency = IntactTable.fieldvalueasstring("XXFREQ")
        rstCust!Frequency = "Docket"
    End If
    'Priced Check
    If IntactTable.fieldvalueasstring("XXPRICED") = "t" Then
        rstCust!Priced = -1
        rstCust!Priced = 0
    End If
    'Active Check
    If IntactTable.fieldvalueasstring("XXACTIVE") = "t" Or IntactTable.fieldvalueasstring("XXACTIVE") = "INVALID" Or IntactTable.fieldvalueasstring("XXACTIVE") = "" Then
        rstCust!Active = -1
        rstCust!Active = 0
    End If
    If IntactTable.fieldvalueasstring("ForceVat") = "T" Then
        rstCust!C_Vol1 = 1
        rstCust!C_Vol2 = IntactTable.fieldvalueasstring("DefVatCode")
        rstCust!C_Vol1 = 0
    End If
    'Other Fields
    rstCust!InvoiceMovements = -1
    rstCust!Currency = "EUR"
    rstCust!Orders = 0
    rstCust!MESSCHK = 0
    rstCust!CustType = "RET"
    'Update record
    r = IntactTable.Next
    If r = -90 Then tmpLastRecord = False
    If IntactTable.fieldvalueasstring("CODE") = "" Then
        tmpLastRecord = False
    End If
Loop While tmpLastRecord

Set rstCust = Nothing
Set IntactTable = Nothing

Exit Function

MsgBox "Intact Customer List Refresh " & Err.Number & vbCrLf & "Details " & Err.Description & vbCrLf & "Intact Msg:" & GetIntactMsg(Err.Number)

Set rstCust = Nothing
Set IntactTable = Nothing

End Function

Adding Data from an excel file to Access

I wrote this macro to populate an access database with the contents from a protected spreadsheet that was distributed to users in different countries. The Excel file was used for Sales Order Entry. I have removed sections for security purposes, however this should serve as a good starting point for you to start your own version.

The idea is to ensure that the data integrity before loading the file and then marking the excel file as imported to prevent accidental duplication in the upload.

I have added comments to the code to explain the main sections, If you have any questions leave a comment.

'generic format

Sub XML_LoadXLTemplate()
' ExportData Macro
' Version 1.0 2-Apr-09
' Designed to export data to the xml data store
Dim tmpTest As Boolean, myfile, tmpStr, tmpFile, tmpPath, x, tmpCells, tmpCount, tmpShipName, tmpAPO
Dim rst As Recordset, db As Database, tmpCountry, tmpEntity, tmpODate, tmpOrderRef, tmpShip5, tmpShip6
Dim tmpShip1, tmpShip2, tmpShip3, tmpShip4, tmpArea, tmpWH, tmpPriceList, tmpStartSheet, tmpShipDate
Dim tmpFailures, rstStock As Recordset, tmpRequestor
Dim tmpPhone, tmpEmail, tmpAttention, tmpWarranty, tmpCrystal, tmpShipVia, tmpShipViaAccount

'|need to set a reference to DAO , under tools
'|references Microsoft DAO 3.6...

Set db = OpenDatabase("\serverYouDatabase.mdb")
Set rst = db.OpenRecordset("tblImportData")

tmpTest = True
tmpStr = ""

Application.ScreenUpdating = False
tmpStartSheet = ActiveSheet.Name

' This cell is populated after the data is imported to ensure the user does not accidentally duplicate the load

If ActiveCell.Value = "Data Imported" Then
    If MsgBox("This sheet has already been imported, Import Again ?", vbYesNo + vbDefaultButton2) = vbNo Then
        Exit Sub
    End If
End If


If FoundWS("SheetName") = False Then  ' FOR FUNCTION SEE
    MsgBox "Cannot find the Order Sheet SheetName"
    Exit Sub
End If


'now check the control cells
tmpFailures = ""

If Len(ActiveCell.Value & "") = 0 Then
    tmpFailures = tmpFailures & "This Order must Contain the Entity Code at D6" & vbCrLf
End If

If Len(ActiveCell.Value & "") = 0 Then
    tmpFailures = tmpFailures & "No Entity name entered at D7 " & vbCrLf
End If
' you can add as many checks to the integrity of the sheet before starting the load

'now check the order lines
i = 1
Do While i < 86 ' I had max 86 lines to validate
    If ActiveCell.Offset(0, 7).Value > 0 Then
        If Len(ActiveCell.Offset(0, 1).Value & "") = 0 Then
            tmpFailures = tmpFailures & "Order Line #" & i & " No part number entered" & vbCrLf
        End If
    End If
    i = i + 1
    ActiveCell.Offset(1, 0).Select

If Len(tmpFailures & "") > 0 Then
    MsgBox "Order Validation Failed " & vbCrLf & vbCrLf & tmpFailures
    Exit Sub
End If

'now move to the first line defined by A2


'set the variables

tmpEntity = ActiveCell.Value
tmpCountry = ActiveCell.Offset(1, 0).Value
tmpShipName = ActiveCell.Offset(3, 0).Value
tmpShip1 = ActiveCell.Offset(4, 0).Value
tmpShip2 = ActiveCell.Offset(5, 0).Value
tmpShip3 = ActiveCell.Offset(6, 0).Value
tmpShip4 = ActiveCell.Offset(7, 0).Value
tmpShip5 = ActiveCell.Offset(8, 0).Value
tmpShip6 = ActiveCell.Offset(9, 0).Value
tmpAttention = ActiveCell.Offset(10, 0).Value
tmpPhone = ActiveCell.Offset(11, 0).Value
tmpEmail = ActiveCell.Offset(12, 0).Value

tmpCells = 28

'move to the start
Cells(tmpCells, 1).Select

'check the value in a1 & h1 is numeric
Do While tmpCount < 86
    If ActiveCell.Offset(0, 7).Value > 0 Then
        'Add the contents to the database
        With rst
            !O_Entity = tmpEntity
            !O_Date = tmpODate
            !O_Part = ActiveCell.Offset(0, 1).Value
            !O_PartOrg = ActiveCell.Offset(0, 1).Value
            '!O_AltPart = ActiveCell.Offset(0, 2).Value
            !O_Desc = Left(ActiveCell.Offset(0, 3).Value, 200)
            !O_qty = ActiveCell.Offset(0, 7).Value
            !O_price = ActiveCell.Offset(0, 9).Value
            !O_Price2 = 0 'ActiveCell.Offset(0, 9).Value
            !O_Extended = !O_qty * !O_price 'ActiveCell.Offset(0, 7).Value
            !O_ImpDate = Now()
            !O_LineShipDate = IIf(Len(ActiveCell.Offset(0, 7).Value & "") = 0, tmpShipDate, ActiveCell.Offset(0, 7).Value)
            !O_OrderDate = tmpODate
            !O_Ship1 = tmpShip1
            !O_Ship2 = tmpShip2
            !O_Ship3 = tmpShip3
            !O_Ship4 = tmpShip4
            !O_Ship5 = tmpShip5
            !O_Ship6 = Left(tmpShip6, 9)
            !O_ShipName = tmpShipName
            !O_Phone = tmpPhone
            !O_EmailAddress = tmpEmail
            !O_Crystalid = tmpCrystal
            !O_Warranty = tmpWarranty
            !O_ShipVia = tmpShipVia & " " & tmpShipViaAccount
            !O_Requestor = tmpRequestor
            !O_Attention = tmpAttention
            !O_Text = 1
            !O_Warehouse = ""
            !O_Number = tmpOrderRef & "-" & !O_Warehouse

            Set rstStock = Nothing

            !O_PriceList = "A"

        End With
    End If
    ActiveCell.Offset(1, 0).Select
    tmpCount = tmpCount + 1

MsgBox "Database updated"

End Sub

Application Switchboard

This is an application I wrote to allow user to easily launch there access programs. If you have used access for even a short time you will notice that the number of reports and application developed internally grows very quickly.

This application allows you to add the application its purpose and field location into a easy to search listing. The user can open the application at any time by double clicking on the listed item.

For more advanced users I have remmed out some registry setting to ensure compliance with the system in larger organisations. Please feel free to ask any questions you may have.

Sales Analysis for MASC

This addon program for MASC allows customers to view the sales Quantities or values by week , month quarter and year compared to the same time period last year.  When you have installed the program you will have to relink to your mascdata. The demonstartion below shows how to populate the fields and demonstrates the reports.

Please leave you questions in the comments section – to download click here and run the program once the file has downloaded


Using Vlookup in Excel files

excelisna1When using the Vlookup or HLookup functions in Excel you will sometimes have #N/A in the cell display as the value cannot be found.

The normal syntax a user would enter in B9 would be VLOOKUP(A9,$A$2:$C$4,2,FALSE) to lookup the value of A9 in the list A2:C4, because the item exists the function returns the value.

In cell B10 the part BD12 does not exist and you get the error #N/A, replace the cell formula with IF(ISNA(VLOOKUP(A14,$A$2:$C$4,2,FALSE)),”None Found”,VLOOKUP(A14,$A$2:$C$4,2,FALSE)) as shown in B14.

In this case I have entered “Not Found” if the value does not exist and in C14  I entered 0.

Who is using my database

When you need to edit a database in a large organisation where you have multiple users you have a number of options

1. kick them out using the server close files option
2. Look up the ldb file to see who has the file open

The problem with the second issue is the LDB file only stores the computer name and not the username or login.

My option is to store the computer and username when the user logins to the system. Create a table in the application ( not in the linked database) and add the columns ComputerName and UserName as text fields call the table tblUsers.

On your main form add an on open event as follows

Dim rst As Recordset
Set rst = CurrentDb.OpenRecordset("select * from tblUsers where ComputerName=" & Chr(34) & Environ("COMPUTERNAME") & Chr(34))
If rst.RecordCount = 0 Then
    'add the user
    rst!UserName = Environ("UserName")
    rst!ComputerName = Environ("ComputerName")
End If
Set rst = Nothing

When you need to update the program you will be able to identify any active users.
Another method to use involved having a hidden form which I will cover and cross link at a later date.

Relinking to your access database

When you are developing an application in house you can define the directory where the backend database will sit. But if your application is used in a number of offices the users will need to relink the program to the source of there database.

I got this code from a developer in the UK in the late 90’s cant remember his name

To use the code open a form and add a text box which the user will enter the path to the file and a button called “relink”

Add an onclick code event to the button and insert the following code

Private Sub cmdRefresh_Click()
   On Error GoTo cmdRefreshErr
   Dim sTest As String, dblocal As Database
   Dim tdlocal As TableDef
   On Error Resume Next
   sTest = Dir(Me![txtFilename])
   On Error GoTo cmdRefreshErr
   If Len(sTest) = 0 Then
      MsgBox "File not found, Please try again.", vbExclamation, "Link to new Data file"
   ElseIf TablesMatch(Me![txtFilename]) Then
      Set dblocal = CurrentDb
      DoCmd.Hourglass True
      For Each tdlocal In dblocal.TableDefs
         If Len(tdlocal.Connect) > 0 Then
            DoCmd.Echo True, "Linking " & tdlocal.Name
            tdlocal.Connect = ";DATABASE=" & Trim(Me![txtFilename])
         End If
      DoCmd.Echo True, "Done"
      DoCmd.Hourglass False
      MsgBox "Linking to new back-end data file was successful."
      DoCmd.Close acForm, Me.Name
      If IsLoaded("frmLoading") Then
        DoCmd.Close acForm, "frmLoading"
        DoCmd.OpenForm "frmLoading"
      End If

      MsgBox "The tables in the data file " & Me![txtFilename] & " didn't match the current database"
   End If
   DoCmd.Echo True
   DoCmd.Hourglass False
   Exit Sub
Select Case Err
Case Else
   MsgBox Err.Number & " - " & Err.descripton
   Resume ExitcmdRefreshErr
End Select
End Sub

Access Dates

This is a simple function I use to convert UK Dates to American dates for use in SQL statements in my access programs.

Function ActDate(passeddate As Date)

Dim SqlStrDate
Select Case Month(passeddate)
Case 1
  SqlStrDate = Day(passeddate) & "/Jan/" & Year(passeddate)
Case 2
  SqlStrDate = Day(passeddate) & "/Feb/" & Year(passeddate)
Case 3
  SqlStrDate = Day(passeddate) & "/Mar/" & Year(passeddate)
Case 4
  SqlStrDate = Day(passeddate) & "/Apr/" & Year(passeddate)
Case 5
  SqlStrDate = Day(passeddate) & "/May/" & Year(passeddate)
Case 6
  SqlStrDate = Day(passeddate) & "/June/" & Year(passeddate)
Case 7
  SqlStrDate = Day(passeddate) & "/July/" & Year(passeddate)
Case 8
  SqlStrDate = Day(passeddate) & "/Aug/" & Year(passeddate)
Case 9
  SqlStrDate = Day(passeddate) & "/Sept/" & Year(passeddate)
Case 10
  SqlStrDate = Day(passeddate) & "/Oct/" & Year(passeddate)
Case 11
  SqlStrDate = Day(passeddate) & "/Nov/" & Year(passeddate)
Case 12
  SqlStrDate = Day(passeddate) & "/Dec/" & Year(passeddate)
End Select
ActDate = SqlStrDate
End Function