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

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 & "") = 0 Then
    tmpFailures = tmpFailures & "This Order must Contain the Entity Code at D6" & vbCrLf
End If

Range("D7").Select
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
Range("a28").Select
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
Loop

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

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 & h1 is numeric
Do While tmpCount < 86
    If ActiveCell.Offset(0, 7).Value > 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 & "") = 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"

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

MsgBox "Database updated"

End Sub