Click here to return to reading 'How to Import an ESRI ASCII Grid into Microsoft Access'.
Click here to download the VBA module to import into your Access VBA Project (.bas file).
------------------------------------------------------------------------------------------------------------------------
Option Compare Database Option Explicit Public Sub ProcessEsriGrid() ' ---------------------------------------------------------------------------------------------------- 'PURPOSE: Processes an ascii Esri grid file and saves the results in an Access database 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 produced by Software-Matters (software-matters.co.uk). You are free to code this
' code within your own project, private or commercial, 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 assigning 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
---------------------------------------------
About Software-Matters:
We have been experts in custom databases, software design, web software and spreadsheet design since 1994.
We are based in Gillingham, Dorset but are close to the county borders of Somerset, Wiltshire and Hampshire. Most of our work is with clients based in the South and South West of England but we cover the whole of the UK. Our aim is to produce you software that does exactly what you want it to. We create custom database software that maximises your business's profit by creating straightforward solutions tailored to your needs.
We use the software already on your desktop to help you save time, prevent mistakes, handle more business, avoid re-work, and therefore maximise your profit.
If you need help with a current project or would like to start something from scratch our team of expert Excel VBA developers and Access programmers are always happy to answer any questions and offer advice.
At Software-Matters we believe in the right solution and if we can't help then we will try our best to point you to someone who can!