Embedded hyperlinks

Apr 27
2009

I was involved with a server move last week which resulted in hundreds of word documents which contained documented processes and procedure for the business with hyperlinks to a server folder which no longer existed. After a short web search this tool was idea, it allows you to specify what you want to replace and you can include all files and sub directories.  http://www.searchandreplace.com/word_sr.htm

sandr

At last they are Gone

Apr 24
2009

Yesterday the Irish government decided to bite the bullet and scrap the e-voting machine which we have wasted millions of euros buying, storing and arranging the logistics !!

So there is nothing new in that but it did remind me of the John Kerry Voting machine video from around the same time, turn your volume down its a bit loud at the end.
 

Scheduling Access Jobs

Apr 23
2009

I used MS scheduler before I found this product from Spliterware ( they say – ‘System Scheduler is an excellent tool to schedule unattended running of applications, batch files, scripts and much more.’)

 

The sample screen below shows the setting I use with Access 2003

 

When used with Access I have a form called frmAutoLoad , when the form is loaded I have an on load event which checks the current time. If the time is not between 10pm and 6am I close the form and open the normal menu. I also add a time event which executes after 25 seconds, this lets the user stop the auto update process if used out of hours.

 

screen1

 

Once you have configured the event you can then schedule the occurances.

 

screen1

Reading a SAP XML file into Access

Apr 21
2009

I use a free product call chilkatxml from chilkatsoft.com, The site has loads of samples but initially I found it difficult to iteriate through the record loops in the xml file.  I have detailed the code I used to load XML orders into an access database.

The first phase is to read the file into an array and the second phase will post that array into an access database. This is similar to theExcel to Access sample but I am using an array to store the data.

Dim xml As ChilkatXml
Dim rec1 As ChilkatXml, rec0 As ChilkatXml
Dim tmpLines(500, 10), i As Integer, tmpCount As Integer ' change the array depth if needed
Dim tmpHeader(25) ' change to the number of headers filds you have
Dim rst As Recordset, rstStock As Recordset
Dim x As Integer
 
' Load the input document.
Set xml = New ChilkatXml
xml.LoadXMLFile tmpFile ' tmpfile is the XML file passed to this function

'Header
Set rec1 = xml.FindChild("Header")
    If (rec1.FindChild2("OrderNumber") = 1) Then
        tmpHeader(1) = rec1.Content
        rec1.GetParent2
    End If
    If (rec1.FindChild2("CreationDate") = 1) Then
        tmpHeader(2) = rec1.Content
        rec1.GetParent2
    End If
    If (rec1.FindChild2("CompanyCode") = 1) Then
        tmpHeader(3) = Right("000" & rec1.Content, 3)
        rec1.GetParent2
    End If
 
'ship address
Set rec1 = xml.FindChild("Partners")
    If (rec1.FindChild2("Identifier") = 1) Then
        tmpHeader(4) = rec1.Content
        rec1.GetParent2
    End If
    If (rec1.FindChild2("Name1") = 1) Then
        tmpHeader(5) = rec1.Content
        rec1.GetParent2
    End If
    If (rec1.FindChild2("Name2") = 1) Then
        tmpHeader(6) = rec1.Content
        rec1.GetParent2
    End If
    If (rec1.FindChild2("Street") = 1) Then
        tmpHeader(7) = rec1.Content
        rec1.GetParent2
    End If
 
    If (rec1.FindChild2("PostCode") = 1) Then
        tmpHeader(8) = rec1.Content
        rec1.GetParent2
    End If
    If (rec1.FindChild2("CountryCode") = 1) Then
        tmpHeader(9) = rec1.Content
        rec1.GetParent2
    End If
 
    If (rec1.FindChild2("City") = 1) Then
        tmpHeader(10) = rec1.Content
        rec1.GetParent2
    End If
 
Set rec1 = xml.FindChild("Items")
 
If (rec1.FirstChild2() = 0) Then
    Set rec1 = Nothing
End If
 
Set rec0 = rec1.GetParent()
 
i = 1
Do While Not (rec0 Is Nothing)
 
    If (rec0.FindChild2("Material") = 1) Then
        tmpLines(i, 1) = rec0.Content
        rec0.GetParent2
    End If
 
    If (rec0.FindChild2("Description") = 1) Then
        tmpLines(i, 2) = rec0.Content
        rec0.GetParent2
    End If
 
    If (rec0.FindChild2("Quantity") = 1) Then
        tmpLines(i, 3) = rec0.Content
        rec0.GetParent2
    End If
 
    If (rec0.FindChild2("DeliveryDate") = 1) Then
        tmpLines(i, 4) = rec0.Content
        rec0.GetParent2
    End If
 
    If (rec0.FindChild2("PricePerUnit") = 1) Then
        tmpLines(i, 5) = rec0.Content
        rec0.GetParent2
    End If
 
    If (rec0.FindChild2("ItemText") = 1) Then
        tmpLines(i, 6) = "" & rec0.Content
        rec0.GetParent2
    End If
 
    If (rec0.FindChild2("InfoRecordPOText") = 1) Then
        tmpLines(i, 7) = "" & rec0.Content
        rec0.GetParent2
    End If
 
    If (rec0.FindChild2("MaterialPOText ") = 1) Then
        tmpLines(i, 8) = "" & rec0.Content
        rec0.GetParent2
    End If
 
    If (rec0.FindChild2("DeliveryText") = 1) Then
        tmpLines(i, 9) = "" & rec0.Content
        rec0.GetParent2
    End If
 
    'now check for vendor material number
    If (rec0.FindChild2("VendorMaterialNumber") = 1) Then
        tmpLines(i, 10) = "" & rec0.Content
        rec0.GetParent2
    End If
 
    ' Move to the next sibling. The internal reference within node is updated
    ' to the node's next sibling. If no siblings remain, it returns 0.
    If (rec0.NextSibling2() = 0) Then
        Set rec0 = Nothing
    End If
 
    i = i + 1
 
Loop
 
' now write the data into the tblImport
Set rst = CurrentDb.OpenRecordset("tblImportData")
 
tmpCount = 0
x = 1
Do While Len(tmpLines(x, 2) & "") > 0
    rst.AddNew
    'rst!O_Number = tmpHeader(1)
    rst!O_Entity = tmpHeader(3)
    rst!O_Date = DateSerial(Left(tmpHeader(2), 4), Val(Left(Right(tmpHeader(2), 4), 2)), Val(Right(tmpHeader(2), 2)))
    If Len(tmpLines(x, 1) & "") > 0 Then
        rst!O_Part = tmpLines(x, 1)
    Else
        'try the vendor material number
        rst!O_Part = tmpLines(x, 10)
    End If
    'rst!O_AltPArt = tmpLines(x, 1)
    rst!O_PartOrg = tmpLines(x, 1)
    rst!O_Desc = tmpLines(x, 2)
    rst!O_Qty = tmpLines(x, 3)
    rst!O_Price = tmpLines(x, 5)
    rst!O_Price2 = tmpLines(x, 5)
    rst!O_Extended = Val(Nz(tmpLines(x, 5), 0)) * Val(Nz(tmpLines(x, 3), 0))
    rst!O_ImpDate = Date
    rst!O_ShipName = tmpHeader(5)
    rst!O_Ship1 = tmpHeader(6)
    rst!O_Ship2 = tmpHeader(7)
    rst!O_Ship3 = tmpHeader(8)
    rst!O_Ship4 = tmpHeader(9)
    rst!O_Ship5 = tmpHeader(10)
    'rst!O_Ship6=""
    rst!O_Processed = 0
    rst!O_Failed = 0
    rst!O_Validated = 0
    rst!O_Disc = 0
    rst!O_Number = tmpHeader(1) & "-" & rst!O_Warehouse
    Set rstStock = Nothing
 
    rst!O_PriceList = "A"
    'rst!O_FailReason
    'rst!O_ORder
    'rst!O_Master
    rst!O_LineShipDate = DateSerial(Left(tmpLines(x, 4), 4), Val(Left(Right(tmpLines(x, 4), 4), 2)), Val(Right(tmpLines(x, 4), 2)))
    'rst!O_OrderDate
    rst!O_Inactive = 0
    rst!O_Text = tmpLines(x, 6) & vbCrLf & tmpLines(x, 7) & vbCrLf & tmpLines(x, 8) & vbCrLf & tmpLines(x, 9) & vbCrLf
    rst.Update
    tmpCount = tmpCount + 1
    x = x + 1
Loop
If tmpCount > 0 Then
    MsgBox "Order Loaded"
Else
    MsgBox "No order lines loaded - check XML File"
End If
 
End Function

Posting Invoices into Sage Line 50 from an Access Database

Apr 19
2009

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
  Else
      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
Else
  rstSource.MoveFirst
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))
         Else
           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)
         rstTrans.MoveNext
      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
   oSalesDeliveryRecord.MoveFirst
   Do
       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)
 Else
   Application.Echo True, "Invoice Not Created"
 End If
loop_routine:
 
rstSource.MoveNext
 
Set oSalesRecord = Nothing
Set oInvoicePost = Nothing
Set oInvoiceItem = Nothing
Set oSalesDeliveryRecord = Nothing
 
 
Loop ' on rstsource

 
Exit_Function:
 
' Disconnect and Destroy Objects
oWS.Disconnect
Set oSDO = Nothing
Set oWS = Nothing
Set db = Nothing
Set rstSource = Nothing
Set rstTrans = Nothing
 
DoCmd.Hourglass False
 
Exit Function
' Error Handling Code
Error_Handler:
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

Apr 17
2009

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
 
Do
    rstCust.AddNew
 
    '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
    Else
        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")
    Else
        rstCust!Frequency = "Docket"
    End If
    'Priced Check
    If IntactTable.fieldvalueasstring("XXPRICED") = "t" Then
        rstCust!Priced = -1
    Else
        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
    Else
        rstCust!Active = 0
    End If
 
    If IntactTable.fieldvalueasstring("ForceVat") = "T" Then
        rstCust!C_Vol1 = 1
        rstCust!C_Vol2 = IntactTable.fieldvalueasstring("DefVatCode")
    Else
        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
    rstCust.Update
 
    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
 
Intact_Error:
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

Apr 15
2009

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("\\server\YouDatabase.mdb")
Set rst = db.OpenRecordset("tblImportData")
 
tmpTest = True
tmpStr = ""
 
Application.ScreenUpdating = False
tmpStartSheet = ActiveSheet.Name
 
Range("I1").Select
' 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
 
Range("A1").Select
 
If FoundWS("SheetName") = False Then  ' FOR FUNCTION SEE http://www.ozgrid.com/forum/showthread.php?t=38108
    MsgBox "Cannot find the Order Sheet SheetName"
    Exit Sub
End If
 
Sheets("SheetName").Select
 
'now check the control cells
tmpFailures = ""
 
Range("D6").Select
If Len(ActiveCell.Value &amp; "") = 0 Then
    tmpFailures = tmpFailures &amp; "This Order must Contain the Entity Code at D6" &amp; vbCrLf
End If
 
Range("D7").Select
If Len(ActiveCell.Value &amp; "") = 0 Then
    tmpFailures = tmpFailures &amp; "No Entity name entered at D7 " &amp; vbCrLf
End If
' you can add as many checks to the integrity of the sheet before starting the load

'now check the order lines
Range("a28").Select
i = 1
Do While i &lt; 86 ' I had max 86 lines to validate
    If ActiveCell.Offset(0, 7).Value &gt; 0 Then
        If Len(ActiveCell.Offset(0, 1).Value &amp; "") = 0 Then
            tmpFailures = tmpFailures &amp; "Order Line #" &amp; i &amp; " No part number entered" &amp; vbCrLf
        End If
    End If
    i = i + 1
    ActiveCell.Offset(1, 0).Select
Loop
 
If Len(tmpFailures &amp; "") &gt; 0 Then
    MsgBox "Order Validation Failed " &amp; vbCrLf &amp; vbCrLf &amp; tmpFailures
    Exit Sub
End If
 
'now move to the first line defined by A2

Range("d6").Select
 
'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
 
Range("A28").Select
tmpCells = 28
 
'move to the start
Cells(tmpCells, 1).Select
 
'check the value in a1 &amp; h1 is numeric
Do While tmpCount &lt; 86
    If ActiveCell.Offset(0, 7).Value &gt; 0 Then
        'Add the contents to the database
        With rst
            .AddNew
            !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 &amp; "") = 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 &amp; " " &amp; tmpShipViaAccount
            !O_Requestor = tmpRequestor
            !O_Attention = tmpAttention
            !O_Text = 1
            !O_Warehouse = ""
            !O_Number = tmpOrderRef &amp; "-" &amp; !O_Warehouse
 
            Set rstStock = Nothing
 
            !O_PriceList = "A"
 
            .Update
        End With
    End If
    ActiveCell.Offset(1, 0).Select
    tmpCount = tmpCount + 1
Loop
 
MsgBox "Database updated"
 
End Sub

Application Switchboard

Apr 10
2009

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.

www.anythingaccess.com/download/emssb.zip

Sales Analysis for MASC

Apr 10
2009

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

salesanalysis

Using Vlookup in Excel files

Apr 09
2009

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.

If you need some help on a project drop leave a comment on the post and I will reply.