Cruise.xlsm is buggy; importing by CSV is more consistent
- This topic has 5 replies, 2 voices, and was last updated 4 years, 8 months ago by
.
-
Posts
-
As I get used to using Assisi I find the Cruise.xlsm to be buggy a hard to use. Many time when attempting to validate the data it deletes fields and replaces the with "#Value!". I find importing data using .csv files to be a little more consistent.
That being said the Import feature within Assisi requires .ini files to map the schema. I created an Excel Macro that outputs these and the .csv files based on data in sheets. The only thing you need to do is name your Sheets and make sure the Column names match the column in the database.
The current version works for Cruise, Plots and Trees tables. Note that each sheet will need the "ThisSheet" object set to match the sheet names.
Just copy and past this whole mess in and Excel Module. Feel free to add or alter any of this code.
Enjoy!
Option Explicit
Declare PtrSafe Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Sub ExportToIni(headers As Range, csvName As String, iniPath As String)
If Dir(iniPath) <> "" Then Kill iniPath
WritePrivateProfileString csvName, "ColNameHeader", "True", iniPath
Open iniPath For Append As #1
Print #1, "Format=CSVDelimited"
Dim c As Range
Dim i As Integer
Dim datatype As String
i = 1
For Each c In headers
Select Case c.Value
Case "Unit": datatype = "Char"
Case "Stand": datatype = "Char"
Case "Cruise": datatype = "Char"
Case "Plot": datatype = "Long"
Case "Tree": datatype = "Long"
Case "SubPlot": datatype = "Long"
Case "Count": datatype = "Single"
Case "Species": datatype = "Char"
Case "DBH": datatype = "Single"
Case "FormFactor": datatype = "Single"
Case "FormPointHeight": datatype = "Single"
Case "CrownBaseHeight": datatype = "Single"
Case "CrownClass": datatype = "Char"
Case "MerchHeight": datatype = "Single"
Case "MerchDiameter": datatype = "Single"
Case "MerchPercentDiameter": datatype = "Single"
Case "TotalHeight": datatype = "Single"
Case "IsBrokenTop": datatype = "Bit"
Case "BrokenHeight": datatype = "Single"
Case "BrokenDiameter": datatype = "Single"
Case "IsSiteTree": datatype = "Bit"
Case "BreastHeightAge": datatype = "Single"
Case "IsOffPlot": datatype = "Bit"
Case "Damage": datatype = "Char"
Case "DecayClass": datatype = "Char"
Case "BoardDefect": datatype = "Single"
Case "IsSnag": datatype = "Bit"
Case "IsStanding": datatype = "Bit"
Case "Notes": datatype = "Char"
Case "CruiseDesign": datatype = "Char"
Case "CruiseDate": datatype = "Date"
Case "Area": datatype = "Single"
Case "StandType": datatype = "Char"
Case "SubPlot1BAF": datatype = "Single"
Case "SubPlot1MinDBH": datatype = "Single"
Case "SubPlot2Radius": datatype = "Single"
Case "StandNotes": datatype = "Char"
Case "Recorder": datatype = "Char"
Case "Latitude": datatype = "Single"
Case "Longitude": datatype = "Single"
End Select
Print #1, "Col" & i & "=" & Chr(34) & CStr(c.Value) & Chr(34) & " " & datatype
i = i + 1
Next
Close #1
End Sub
Public Sub ExportCSV(headerRange As Range, CurrentSheet As Worksheet, PathName As String)
Dim totline As Long
Dim lastcol As Long
Dim i As Long
Dim TempWB As Workbook
Dim sheetname As String: sheetname = CurrentSheet.Name
Dim k As Long
totline = CurrentSheet.Range("A" & Rows.Count).End(xlUp).Row
lastcol = CurrentSheet.Cells(1, CurrentSheet.Columns.Count).End(xlToLeft).Column
headerRange.Copy
Set TempWB = Application.Workbooks.Add(1)
TempWB.Sheets(1).Name = sheetname
TempWB.Sheets(sheetname).Range("A1").PasteSpecial xlPasteValues
For i = 2 To totline
TempWB.Sheets(sheetname).Range(TempWB.Sheets(sheetname).Cells(i, 1), TempWB.Sheets(sheetname).Cells(i, lastcol)).Value _
= CurrentSheet.Range(CurrentSheet.Cells(i, 1), CurrentSheet.Cells(i, lastcol)).Value
Next i
Application.DisplayAlerts = False
TempWB.SaveAs Filename:=PathName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close savechanges:=False
Application.DisplayAlerts = True
End Sub
Sub ExportData()
Dim ThisSheet As Worksheet
Dim FilePath As String
Dim MyFolder As String
Dim MyFileName As String
Dim FolderExists As String
Dim Project As String
Dim headerRange As Range
Dim Nname As String, iniName As String
Dim ThisName As String
FilePath = ThisWorkbook.Path
Project = "CSV Export(" & Format(Date, "mm dd yyyy") & ")" '<<<<Folder name
'*********************Create Folder**********************
FilePath = FilePath & "" & Project
FolderExists = Dir(FilePath, vbDirectory)
If FolderExists = "" Then
MkDir (FilePath)
End If
'*****************************************************Stands_List*********************************************************
'——-Hard set these values————————
Set ThisSheet = ThisWorkbook.Sheets("Cruise")
With ThisSheet
Set headerRange = .Range(.Cells(1, 1), .Cells(1, .Cells(1, .Columns.Count).End(xlToLeft).Column))
End With
'—————————————————-
Nname = ThisSheet.Name & ".csv"
iniName = ThisSheet.Name & ".ini"
MyFileName = FilePath & Nname
'create ini file for import to Assisi
ExportToIni headerRange, Nname, FilePath & iniName
'create .csv file
ExportCSV headerRange, ThisSheet, MyFileName
'*****************************************************Plots_List*********************************************************
'——-Hard set these values————————
Set ThisSheet = ThisWorkbook.Sheets("Plots")
With ThisSheet
Set headerRange = .Range(.Cells(1, 1), .Cells(1, .Cells(1, .Columns.Count).End(xlToLeft).Column))
End With
'—————————————————-
Nname = ThisSheet.Name & ".csv"
iniName = ThisSheet.Name & ".ini"
MyFileName = FilePath & Nname
'create ini file for import to Assisi
ExportToIni headerRange, Nname, FilePath & iniName
'create .csv file
ExportCSV headerRange, ThisSheet, MyFileName
'*****************************************************Tree_List*********************************************************
'——-Hard set these values————————
Set ThisSheet = ThisWorkbook.Sheets("Trees")
With ThisSheet
Set headerRange = .Range(.Cells(1, 1), .Cells(1, .Cells(1, .Columns.Count).End(xlToLeft).Column))
End With
Nname = ThisSheet.Name & ".csv"
iniName = ThisSheet.Name & ".ini"
MyFileName = FilePath & Nname
'create ini file for import to Assisi
ExportToIni headerRange, Nname, FilePath & iniName
'create .csv file
ExportCSV headerRange, ThisSheet, MyFileName
MsgBox ("Data Successfully Exported")
End Sub
I'm thinking the old CSV import needs an update for newer fields. I may not have maintained it. I will put that on my list. 😉
Can you send me some CSV and INI files to test with?
Thanks Rich.I have a lot of small landowner runs I do and I find this method bridges the gap between my cruise data and Assisi a little more efficiently. Though I did find the plot level data is not fully transferring. specifically the Lat/Long and Recorder values don't populate. I'm sure there is something I'm missing.I also found I have trouble while using Single BAF design. the error is something like "missing subplot #2 values" or similar. when using single BAF does the "cruises" table need to be formatted a different way? maybe the "trees" table column "subplot" needs a specific number value? I plan to implement this as a loop through all sheets type code, and incorporate things like Calibration and Market just to make it Compile ready. Do you have a master Schema for required tables handy?FYI, If my code is messy, feel free to red pen any of it. Cheers!
Thanks Josh. The Cruise sheet started with doing exactly that: export to CSV. It was removed after Assisi began directly loading the Excel Cruise sheet itself. Maybe I should add back the export to CVS option. Maybe they both can coexist.Modifying the Cruise sheet for new fields and validation is encouraged. But the Excel validation code must be changed to ensure what sheet columns are what.If anyone struggles, I (or Josh!) can help debug for you.Rich
Here's the old Excel VBA for a 2012 Cruise sheet. It has the Export() function and more that might be helpful.
- You must be logged in to reply to this topic.