Attribute VB_Name = "ProcessEsri"
Option Compare Database
Option Explicit

Public Sub ProcessEsriGrid()
' ----------------------------------------------------------------------------------------------------
'PURPOSE: Processes an ascii Esri grid file and saves the results in an Access table.

'REQUIREMENTS: Reads from a ESCI ASCII Raster Format data file.

'EFFECTS: Adds the data from the file to an Access Table. In this case we do a
'couple of calculations on it to get the data in the form we want. The file itself is unaffected.

' NOTE: every time the Input function is used, it starts taking input from the character
'after the last character read in the previous use of Input.

' USAGE: This sample code was producted by Software-Matters (software-matters.co.uk). You are free to code this
' code within your own project, private or commerical, provided you give proper attribution to Software-Matters
' as the author. You must keep this message intact. ' You may not resell this source code by itself or as part of
' a collection. You may not post this code or any portion of this code in electronic format.
' The code or sample database may only be downloaded from: www.software-matters.co.uk
' Copyright Software-Matters 2013

' ----------------------------------------------------------------------------------------------------
    'SETUP
    
    On Error GoTo ErrorTrap
    
    Dim fname As String, temp As String
    Dim ncols As Integer, nrows As Integer, xll As Single, yll As Single, cs As Double, nodata As Double, startdata As Long
    Dim counter As Long, currdata As String, currcol As Integer, currrow As Integer
    Dim rs As Recordset

    fname = CurrentDb.Containers("Databases")!userdefined.Properties!EsriFile ' we have written the file path to the data into our database as a custom property
    Set rs = CurrentDb.OpenRecordset("MyTable") ' Make sure to input your own table name here!

    Close 'closes file if open from previous use
    Open fname For Input Access Read As #1
    ' The '#1' is a file number that we are assinging to the Esri file. If you plan to use this code alongside other code that
    ' opens files, you should try using the FreeFile() function to make sure you assign this new file a number that isn't already in use.
    ' From now on we'll refer to our file using just this file number.
    
    ' ------------------------------------------------------------------------------
    ' ACQUIRING HEADER INFORMATION
    
    'Read in the first 150 characters to pick up the header information, all of which is needed to correctly import the actual data.
    'Use a larger number if you have extremely large values in your header.
    temp = Input(150, #1)
    
    ' Now we must get all the header information we need by taking the correct parts of the temp string based on its structure.
    'ncols is from the character after "ncols " in the file up to the character before the start of "nrows " in the file
    ncols = CInt(Mid(temp, InStr(1, temp, "ncols ") + 6, InStr(1, temp, "nrows ") - InStr(1, temp, "ncols ") - 6 - 1))
    'nrows is from the character after "nrows " in the file up to the character before the start of "xll" in the file
    nrows = CInt(Mid(temp, InStr(1, temp, "nrows ") + 6, InStr(1, temp, "xll") - InStr(1, temp, "nrows ") - 6 - 1))
    'xll is from the character after "xllcorner " in the file up to the character before the start of "yll" in the file
    xll = CDbl(Mid(temp, InStr(1, temp, "xllcorner ") + 10, InStr(1, temp, "yll") - InStr(1, temp, "xllcorner ") - 10 - 1))
    'yll is from the character after "yllcorner " in the file up to the character before the start of "cellsize " in the file
    yll = CDbl(Mid(temp, InStr(1, temp, "yllcorner ") + 10, InStr(1, temp, "cellsize ") - InStr(1, temp, "yllcorner ") - 10 - 1))
    'cs is from the character after "cellsize " in the file up to the character before the start of "nodata" in the file
    cs = CDbl(Mid(temp, InStr(1, temp, "cellsize ") + 9, InStr(1, temp, "nodata") - InStr(1, temp, "cellsize ") - 9 - 1))
    'nodata is from the character after "nodata_value " in the file up to the character before the NEXT chr(10) in the file
    nodata = CDbl(Mid(temp, InStr(1, temp, "nodata_value ") + 13, InStr(InStr(1, temp, "nodata_value "), temp, Chr(10)) - InStr(1, temp, "nodata") - 13))
    startdata = InStr(InStr(1, temp, "nodata_value "), temp, Chr(10)) + 1 'look for the next chr(10) after nodata and then data starts in character after that
    Close
    ' -----------------------------------------------------------------------------
    'PROCESSING AND WRITING TO ACCESS TABLE
    
    'With the header information collected, we now need to use it to interpret the stream of numbers that makes up the data portion of the file
    Open fname For Input Access Read As #1 'FreeFile 'reopen file to start again
    temp = Input(startdata - 1, #1) 'discard these as they are not data
    counter = 1
    currcol = 1
    currrow = 1
    'get a data point value
    Do Until EOF(1)
        currdata = currdata & Input(1, #1) ' loop the addition of single characters until a piece of data is fully selected, indicated by there being a space after it
        If Right(currdata, 1) = " " Then
            currdata = Left(currdata, Len(currdata) - 1) ' remove space
            'currdata is now a string containing the data point value

            'Next we calculate the x and y values for our database
            If CDbl(currdata) <> nodata Then ' if our datapoint isn't just the placeholder selected to represent a lack of data, defined by the last parameter in the header
                rs.AddNew
                rs!PointNo = counter
                rs!DataValue = CDbl(currdata)
                rs!x = xll + cs * (currcol - 1) ' origin of coordinate + size of cell * number of cells
                rs!y = yll + cs * (nrows - currrow) ' origin of coordinate + size of cell * (number of rows between the bottom of the raster and the current row)
                rs.Update
            End If

            counter = counter + 1
            currcol = currcol + 1 'this increments for every point but resets at start of each row in the If below
            If currcol > ncols Then ' once we've passed the last column...
                currcol = 1 ' jump back to first column, but ...
                currrow = currrow + 1 ' progress to the next row
            End If
            currdata = "" 'Empty the data string ready to start adding the next set of characters
        End If
    Loop
    ' ---------------------------------------------------------------------------
    ' CLOSING
    
    MsgBox "Data Import Complete."
    
ExitRoutine:
    Close
    rs.Close
    Set rs = Nothing
    Exit Sub
    
ErrorTrap:
    MsgBox Err.Number & " " & Err.Description
    Resume ExitRoutine
    
End Sub