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
Can you send me some CSV and INI files to test with?