Visual Basic for Applications/VBA Code to Read ASCII Log Data from LAS File

From Wikibooks, open books for an open world
Jump to navigation Jump to search

Summary[edit | edit source]

This page lists a VBA Sub procedure to read data from a LAS file. A LAS file is an industry-standard binary format for storing airborne LIDAR data. Sub procedure requirements:

  • A LAS file must be located in the same folder where the macro-enabled Excel file is located
  • The active worksheet must have in cell A1 the name of the LAS file

VBA Code[edit | edit source]

Sub ReadProperties()
  Dim numWords As Long
  Dim stringLine As String, fileName As String, lineStringVector() As String, headerStart As String
  Dim n As Long, i As Long, numLineHeader As Long, lenStringVector As Long, j As Long
  Dim colStart As Long, numProp As Long
  Dim rowStart As Long, rowNumCounter As Long, numDepths As Long
  Dim StartDatProp As Range, dataArray(1 To 10000, 1 To 20) As Double

  fileName = Cells(1, 1).Value
  Cells(1, 2).Value = "Num Prop:": Cells(1, 4).Value = "Num Depths"
  
  n = 0: rowStart = 2: colStart = 2: rowNumCounter = 1

  Open fileName For Input As 1
  Do While Not EOF(1)
    Line Input #1, stringLine
    headerStart = Left(stringLine, 2) ' stores in headerStart the first two characters of the string stringLine
    If headerStart = "~A" Then
       numLineHeader = n + 1
       lineStringVector() = Split(Trim(stringLine), " ")
       lenStringVector = UBound(lineStringVector) - LBound(lineStringVector) + 1
       numWords = 0: j = 1
       For i = 0 To lenStringVector - 1
          If lineStringVector(i) <> "" Then
             numWords = numWords + 1
             Cells(rowStart, j).Value = lineStringVector(i)
             j = j + 1
          End If
       Next i
       numProp = numWords - 1
       Cells(1, 3).Value = numProp
    End If
    If numLineHeader > 0 And n >= numLineHeader Then
      lineStringVector() = Split(Trim(stringLine), " ")
      lenStringVector = UBound(lineStringVector) - LBound(lineStringVector) + 1
      j = 0
      For i = 0 To lenStringVector - 1
            If lineStringVector(i) <> "" Then
               Cells(rowStart + rowNumCounter, colStart + j).Value = lineStringVector(i)
               dataArray(rowNumCounter, j + 1) = lineStringVector(i)
               j = j + 1
            End If
      Next i
      rowNumCounter = rowNumCounter + 1
    End If
    n = n + 1
  Loop
  Close 1
  numDepths = rowNumCounter - 1
  Cells(1, 5).Value = numDepths
  Cells(rowStart, 2).Select
  Range(Selection, Selection.End(xlDown)).Select
  Range(Selection, Selection.End(xlToRight)).Select
  Selection.NumberFormat = "0.000"
  Cells(rowStart, 2).Select
End Sub

Example Data to Test[edit | edit source]

You may create a ASCII file with extension LAS using the following example of data.

Screenshot showing content of LAS file
Screenshot showing data in LAS file

Output on worksheet after running VBA Sub[edit | edit source]

Screenshot showing Excel active worksheet after running VBA Sub
Shows screenshot of Excel worksheet