Jump to content

VBS script to create csv from county downloads


rogbarn

Recommended Posts

A while back, I wrote a vbs script to extract data from the county download files from the NGS and create a CSV file that I read into Excel for further research. I offer to anyone who finds it useful. It requires Windows and I'm not sure if there are any further restrictions. I am going to try to attach it as a .txt file. Copy it to your machine, rename it to .vbs and edit it (do not double click on it). Change line 25 to the state you want to process. It will append ".txt" to form the file name. The file should be in the same directory as the vbs. Save it and then double click on it to run it. It will create a file named xx_benchmarks.csv where xx is the state of the input file. This was written for my own use and I have no idea how well it will work in the larger world. But I'm will to make sensible changes if there is a need. The obvious one is to automatically recognize incoming files. Have fun!

 

I couldn't attach it so I'm putting the whole thing right here. Open a text based window (e.g. notepad or wordpad) and save it as a .vbs file. Don't forget that if you want to edit it, you have to right click on it and select "open with". Double clicking on it will run it.

 

Hopefully this will work out OK.

 

Option Explicit
'Variables for input and output file processing

Dim iFSO, iFile, sInputLine, oFile, sOutputLine, iDir, oDir
Dim StateIn, DateStamp, TimeStamp
Dim RecordsIn, DataSheetsIn, RecordsOut
Dim Designation, PID, StateCounty
Dim LatDeg, LatMin, LatSec, LongDeg, LongMin, LongSec, AdjorScaled
Dim Latitude, Longitude, MarkerCode, MarkerDesc
Dim FirstDate, FirstCondition, FirstReportBy
Dim LastDate, LastCondition, LastReportBy


'Dim strItem, LineNum, LineLen, LinesOut, PrevLine, LineCnt
'Dim Start1, Stop1, Start2, Stop2, EndNum
'Dim FileNum, CommaLoc

dateStamp = Date()
timeStamp = Time()

'Value assignment for input and output files
iDir = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName)))
oDir = iDir

StateIn = "il"
iFile = StateIn & ".txt"
oFile = oDir & StateIn & "_benchmarks.csv"

'------------------------- open output file -------------------------
Set iFSO = CreateObject("Scripting.FilesyStemObject")
Set oFile = iFSO.OpenTextFile(oFile, 2, True)
'oFile.WriteLine("Starting at " & DateStamp & " " & TimeStamp)

If not iFSO.FileExists(iFile) Then
   Wscript.Echo "Can't find file " & IFile
   wscript.Quit 
End If

Set ifile = iFSO.OpenTextFile(iFile)  

sOutputLine = "PID,Designation,State/County,Latitude,Longitude,Adj/Scaled,type,Type description,"
sOutputLine = sOutputLine & "First date,Mon/Obs,First agency,Last date,Last condition,Last agency"
oFile.WriteLine(sOutputLine)

'Read and loop through the input file

'read the first record and ignore it
sInputLine = ifile.ReadLine
RecordsIn = 1

'skip until you get to the first header line
Do until mid(sInputLine,1,1) = "1"
 sInputLine = ifile.ReadLine
Loop

'Do until RecordsIn > 2000
Do until ifile.AtEndOfStream
 sInputLine = ifile.ReadLine
 'BEGINNING PART
 if mid(sInputLine,10,11) = "DESIGNATION" then
   DataSheetsIn = DataSheetsIn + 1
   Designation = mid(sInputLine,25,40) 
 End If
 if mid(sInputLine,8,5) = "  PID" then
   PID = mid(sInputLine,25,6) 
 End If
 if mid(sInputLine,10,12) = "STATE/COUNTY" then
   StateCounty = mid(sInputLine,25,40) 
 End If

 'CURRENT SURVEY CONTROL
 If mid(sInputLine,8,6) = "* NAD " then
   LatDeg = mid(sInputLine,25,2) 
   LatMin = mid(sInputLine,28,2) 
   If mid(sInputLine,34,5) = "     " then
     LatSec = mid(sInputLine,31,2) 
   else
     LatSec = mid(sInputLine,31,8) 
   End If
   LongDeg = mid(sInputLine,46,3) 
   LongMin = mid(sInputLine,50,2) 
   If mid(sInputLine,56,5) = "     " then
     LongSec = mid(sInputLine,53,2) 
   else
     LongSec = mid(sInputLine,53,8) 
   End If
   AdjorScaled = mid(sInputLine,69,40) 
   Latitude = LatDeg + (LatMin / 60) + (LatSec / 3600)
   Longitude = (LongDeg + (LongMin / 60) + (LongSec / 3600)) * -1
 End If

 If mid(sInputLine,8,8) = "_MARKER:" then
   If mid(sInputLine,17,7) = "STATION" then
     MarkerCode = mid(sInputLine,32,2) 
     MarkerDesc = mid(sInputLine,32,99) 
   elseif mid(sInputLine,18,1) = " " then
     MarkerCode = mid(sInputLine,17,1) 
     MarkerDesc = mid(sInputLine,21,40) 
   else
     MarkerCode = mid(sInputLine,17,2) 
     MarkerDesc = mid(sInputLine,22,40) 
   End If
 End If

 If mid(sInputLine,10,7) = "HISTORY" And mid(sInputLine,24,4) <> "Date" then
   If FirstDate = "" then 
     FirstDate = mid(sInputLine,24,8) 
     FirstCondition = mid(sInputLine,33,16) 
     FirstReportBy = mid(sInputLine,50,10) 
   End If
   LastDate = mid(sInputLine,24,8) 
   LastCondition = mid(sInputLine,33,16) 
   LastReportBy = mid(sInputLine,50,10) 
 End If

 'if last record for the dataset, output dataset info
 If mid(sInputLine,2,6) = "      " then
   sOutputLine = PID & ",""" & Designation & """," & StateCounty & ","
'    sOutputLine = sOutputLine & LatDeg & "," & LatMin & "," & LatSec & "," 
'    sOutputLine = sOutputLine & LongDeg & "," & LongMin & "," & LongSec & "," & AdjOrScaled & "," 
   sOutputLine = sOutputLine & Latitude & "," & Longitude & "," & trim(AdjOrScaled) & ","
   sOutputLine = sOutputLine & MarkerCode & "," & MarkerDesc & "," 
   sOutputLine = sOutputLine & trim(FirstDate) & "," & trim(FirstCondition) & "," & FirstReportBy & "," 
   sOutputLine = sOutputLine & trim(LastDate) & "," & trim(LastCondition) & "," & LastReportBy
   oFile.WriteLine(sOutputLine)
   RecordsOut = RecordsOut + 1
   PID = ""
   Designation = ""
   StateCounty = ""
   AdjOrScaled = ""
   MarkerCode = ""
   MarkerDesc = ""
   LatDeg = ""
   LatMin = ""
   LatSec = ""
   LongDeg = ""
   LongMin = ""
   LongSec = ""
   Latitude = ""
   Longitude = ""
   FirstDate = ""
   FirstCondition = ""
   FirstReportBy = ""
   LastDate = ""
   LastCondition = ""
   LastReportBy = ""
 End If
 RecordsIn = RecordsIn + 1
Loop 

iFile.Close
Set ifile = Nothing

dateStamp = Date()
timeStamp = Time()
'oFile.WriteLine("Lines read: " & RecordsIn & "  Lines written: " & RecordsOut)
'oFile.WriteLine("Ending at " & DateStamp & " " & TimeStamp)
oFile.Close
Set oFile = Nothing

Set iFSO = Nothing
wscript.echo RecordsOut & " lines Written" & vbcrlf & "FileReader.vbs DONE!"
'wscript.echo "FileReader.vbs DONE!"

Link to comment

The fields that are extracted are:

PID

Designation

State/County

Latitude (decimal) - converted to decimal from the DMS on the "* NAD " line

Longitude (decimal) - converted to decimal from the DMS on the "* NAD " line

Adj/Scaled - whatever is at the end of the "* NAD" line

Type - from the "MARKER" line

Type description - from the "MARKER" line

First date - from the first recovery line

Mon/Obs - from the first recovery line

First agency - from the first recovery line

Last date - from the last recovery line

Last condition - from the last recovery line

Last agency - from the last recovery line

Link to comment

Did anyone try this? This is my first time at sending out code that I've written for myself to a wider audience. Do you think it has potential? What changes do I need to make? Feedback will be greatly appreciated! Thanks.

 

Rogbarn, if you would like, you can email me the file, and I will put it on our local geocaching website...to provide a host for it, and a link for others to download the complete file from, instead of having to copy/paste the code. It might make it easier that way.

 

I know Kayakbird is an avid excel user.

 

my email is hktire@aol.com

 

Bobby

Edited by LSUFan
Link to comment

Nice!

 

once I figured out the first step, it ran as advertised.

 

Any way to get the description to be extracted?

 

Glad it worked for you. Which one did you use, the one I posted above or the one that LSUfan posted somewhere? (I don't know where did he put it, hopefully he'll pop in and let us know) The one I gave to LSUfan has some improved file handling capabilities.

 

As for the description, do you mean the first recovery description? I'll see what I can do.

Link to comment

I used the one you posted here. With it, I was able to generate additional fields for a master shapefile I'm creating for my area.

 

By description, I mean the location description paragraph.

 

I understand that the paragraphs range from a sentence to several lines of description, but I just wondered if it was possible.

Link to comment

script works great!

 

can get the extracted information to the spreadsheet (csv file) stage, can that spreadsheet be opened in GSAK or something similar to get it to the GPSr?

 

tried to open it, but GSAK keeps crashing on me, not sure if it is a setting I am missing or it just can not be done. I tried File->Load->(load option)->text(with first line field structure)

 

thanks

Link to comment

replying to myself :)

 

I worked out this morning that if you change the column headings you can bring the data in GSAK

 

I had to delete the date columns (couldn't work out how to get those to work correctly)

 

I changed the column headings to userdata,user2,State/County,Latitude,Longitude,url,user3,user4,status,placedby,container,ownername

 

might not be the most descriptive column headings, but they work...

 

thanks for the script....

 

 

and a little bit more working (playing) around with this...

to send it to a GPSr (atleast the Garmin eTrex)

 

GPS->send waypoints->(uncheck defaults), change waypoint name to %macro (all the waypoints will show as a macro) and change waypoint description to %user %user4 (for me that would be the PID and marker)

 

thanks again for the script....

Edited by st_moose
Link to comment

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
×
×
  • Create New...