| ' http://www-10.lotus.com/ldd/sandbox.nsf/Threads/7D3285A6721418ED85256DF2006561E9?OpenDocument |
| ' the code |
| ' http://www-10.lotus.com/ldd/sandbox.nsf/ByDateNJ/7D3285A6721418ED85256DF2006561E9/$FILE/LibCSVFile.txt?OpenElement |
| ' the correction for double quotes |
| ' http://www-10.lotus.com/ldd/sandbox.nsf/Threads/497A027502F863E5852571550034C179?OpenDocument |
| ' but see as well improved version in http://atnotes.de/index.php/topic,15004.0.html |
| ' |
| ' ****** SAMPLE USAGE OF CSVFILE ****** |
| ' This call of csv.Import imports and synchronized |
| ' * ItemID (Item ID) |
| ' * ItemDesignation (Item Designation) |
| ' * ItemDetails (Item Details) |
| ' * ItemAmount (Item Amount) |
| ' * ItemCurrency (Item Currency) |
| ' into this database with the form called "F_Item" and five fields "ItemID" "ItemDesignation", "ItemDetails", "ItemAmount" and "ItemCurrency" |
| ' This database has got a view called "V_Item" with selection formula on Form "F_Item", docs are sorted by "ItemID" |
| ' This code imports the data into the database |
| ' synchronizes the data if it already exists |
| ' and deletes docs with "ItemID" not found in the CSV file |
| ' ** |
| ' ** Dim csv As CSVFile |
| ' ** Dim st_Fields(1 To 5) As String |
| ' ** Dim type_Fields(1 To 5) As Variant |
| ' ** |
| ' ** st_Fields(1) = "ItemID" |
| ' ** st_Fields(2) = "ItemDesignation" |
| ' ** st_Fields(3) = "ItemDetails" |
| ' ** st_Fields(4) = "ItemAmount" |
| ' ** st_Fields(5) = "ItemCurrency" |
| ' ** |
| ' ** type_Fields(1) = "Number" |
| ' ** type_Fields(2) = "String" |
| ' ** type_Fields(3) = "String" |
| ' ** type_Fields(4) = "Number" |
| ' ** type_Fields(5) = "String" |
| ' ** |
| ' ** if a field is of type number, then mention this with "Number" |
| ' ** if a field is of type date, then mention this with "Date" |
| ' ** if a field is of type datetime, then mention this with "DateTime" |
| ' ** if a field is of type time, then mention this with "Time" |
| ' ** |
| ' ** Set csv = New CSVFile("","F_Item", st_Fields, type_Fields) |
| ' ** |
| ' ** csv.Synchronize = True |
| ' ** csv.SynchronizeView = "V_Item" |
| ' ** csv.SynchronizeDeletions = True |
| ' ** |
| ' ** Call csv.Import |
| Class CSVFile |
| Public FileName As String |
| Public Delimiter As String |
| Public ImportDatabase As NotesDatabase |
| Public ImportForm As String |
| Public ImportFields As Variant ' ARRAY OF FIELD NAMES - **INDEX MUST START WITH 1** |
| Public TypeFields As Variant ' ARRAY OF FIELD TYPES - **INDEX MUST START WITH 1** |
| Public RefreshForm As Variant |
| Public ShowProgress As Variant |
| Public QuoteDelimiter As Variant ' IS A DOUBLE QUOTE USED TO SEPARATE VALUES WITH COMMAS |
| Public Synchronize As Variant ' SHOULD THE IMPORT SYNCH BASED ON KEY VALUES |
| Public NumKeyFields As Integer ' HOW MANY OF THE FIRST FIELDS ARE KEY VALUES |
| Public SynchronizeView As String ' NAME OF VIEW TO USE TO SYNCHRONIZE USING KEY VALUES |
| Public SynchronizeDeletions As Variant |
| Public SkipTitleLine As Variant |
| Public NumChanges As Integer |
| Public NumAdds As Integer |
| Public NumDeletes As Integer |
| Private SynchUNIDS List As String |
| |
| Sub New(st_FileName As String, st_FormName As String, v_FieldArray As Variant, v_TypeArray As Variant) |
| Dim lib_s As New NotesSession |
| Dim lib_ws As New NotesUIWorkspace |
| Dim v_ReturnValue As Variant |
| If Trim(st_FileName) = "" Then ' IF NO FILE NAME GIVEN - PROMPT FOR FILE |
| v_ReturnValue = lib_ws.OpenFileDialog(False, "Select a CSV file", "CSV Files|*.CSV", "C:\") |
| If Not Isarray(v_ReturnValue) Then Exit Sub |
| If v_ReturnValue(0) = "" Then Exit Sub |
| st_FileName = v_ReturnValue(0) |
| End If |
| Me.FileName = st_FileName |
| Set Me.ImportDatabase = lib_s.CurrentDatabase |
| Me.ImportForm = st_FormName |
| Me.ImportFields = v_FieldArray |
| Me.TypeFields = v_TypeArray |
| Me.RefreshForm = True |
| Me.ShowProgress = True |
| Me.QuoteDelimiter = True |
| Me.NumKeyFields = 1 |
| Me.NumChanges = 0 |
| Me.NumAdds = 0 |
| Me.NumDeletes = 0 |
| End Sub |
| |
| Sub Import |
| Dim i_FileNum As Integer |
| Dim st_LineData As String |
| Dim i_ImportCount As Integer |
| Dim vw_Lookup As NotesView |
| Dim doc_List As NotesDocument |
| If Trim(Me.FileName) = "" Then |
| Messagebox "No file name specified.", 16, "Error" |
| Exit Sub |
| End If |
| If Me.Synchronize Then |
| Set vw_Lookup = Me.ImportDatabase.GetView(Me.SynchronizeView) |
| If vw_Lookup Is Nothing Then |
| Messagebox "Invalid synch view name.", 16, "Error" |
| Exit Sub |
| End If |
| Call vw_Lookup.Refresh ' REFRESH THE VIEW SO IT HAS MOST RECENT DATA |
| If Me.SynchronizeDeletions Then |
| ' BUILD LIST |
| Set doc_List = vw_Lookup.GetFirstDocument |
| Do While Not doc_List Is Nothing |
| Me.SynchUNIDS(doc_List.UniversalID) = False |
| Set doc_List = vw_Lookup.GetNextDocument(doc_List) |
| Loop |
| End If |
| End If |
| If Not Isarray(Me.ImportFields) Then |
| Messagebox "Invalid field name array.", 16, "Error" |
| Exit Sub |
| End If |
| i_FileNum = Freefile() |
| Open Me.FileName For Input As i_FileNum |
| i_ImportCount = 0 |
| ' SKIP THE TITLE LINE IF SPECIFIED |
| If Not Eof(i_FileNum) And Me.SkipTitleLine Then Line Input #i_FileNum, st_LineData |
| Do While Not Eof(i_FileNum) |
| i_ImportCount = i_ImportCount + 1 |
| If Me.ShowProgress Then Print "Importing record # " & Cstr(i_ImportCount) |
| Line Input #i_FileNum, st_LineData ' GRAB A LINE FROM THE FILE |
| If Not Me.Synchronize Then |
| If Not ImportLine(st_LineData) Then |
| Messagebox "Error during import.", 16, "Error" |
| Close i_FileNum |
| Exit Sub |
| End If |
| Else |
| If Not SynchLine(st_LineData) Then |
| Messagebox "Error during synchronization.", 16, "Error" |
| Close i_FileNum |
| Exit Sub |
| End If |
| End If |
| Loop |
| Close i_FileNum |
| If Me.Synchronize And Me.SynchronizeDeletions Then |
| Forall x In Me.SynchUNIDS |
| If x = "False" Then ' IF NO MATCH FOUND IN CSV FILE THEN DELETE DOCUMENT (RECORD) |
| Call Me.ImportDatabase.GetDocumentByUNID(Listtag(x)).Remove(True) |
| Me.NumDeletes = Me.NumDeletes + 1 |
| End If |
| End Forall |
| End If |
| Print "Import completed. " & Cstr(i_ImportCount) & " records processed. " & Cstr(Me.NumAdds) & " added, " & Cstr(Me.NumChanges) & " changed, " & Cstr(Me.NumDeletes) & " deleted." |
| End Sub |
| |
| ' IMPORTS THE DATA - CREATES A NEW DOCUMENT FOR EACH LINE IN CSV FILE |
| Private Function ImportLine(st_LineData As String) As Variant |
| Dim v_ValueArray As Variant |
| Dim i As Integer |
| Dim doc_Current As NotesDocument |
| ImportLine = True |
| v_ValueArray = ReturnValueArray(st_LineData) ' BREAK UP THE DATA INTO AN ARRAY |
| Set doc_Current = Me.ImportDatabase.CreateDocument |
| For i = Lbound(Me.ImportFields) To Ubound(Me.ImportFields) |
| Call doc_Current.ReplaceItemValue(Me.ImportFields(i), v_ValueArray(i)) |
| Next |
| doc_Current.Form = Me.ImportForm |
| If Me.RefreshForm Then Call doc_Current.ComputeWithForm(False, True) |
| Call doc_Current.Save(True, False) |
| Me.NumAdds = Me.NumAdds + 1 |
| End Function |
| |
| ' IMPORTS THE DATA - SYNCHRONIZING THE DOCUMENT BASED ON KEY FIELDS |
| Private Function SynchLine(st_LineData As String) As Variant |
| Dim v_ValueArray As Variant |
| Dim v_Key As Variant |
| Dim v_TempKey (1 To 10) As Variant |
| Dim i As Integer |
| Dim doc_Current As NotesDocument |
| Dim vw_Lookup As NotesView |
| Dim v_FieldChange As Variant |
| SynchLine = True |
| v_ValueArray = ReturnValueArray(st_LineData) ' BREAK UP THE DATA INTO AN ARRAY |
| ' BUILD THE KEY |
| For i = 1 To Me.NumKeyFields |
| v_TempKey(i) = v_ValueArray(i) |
| Next |
| ' INSTANTIATE THE VIEW |
| Set vw_Lookup = Me.ImportDatabase.GetView(Me.SynchronizeView) |
| ' LOOKUP THE DOCUMENT |
| Set doc_Current = vw_Lookup.GetDocumentByKey(v_ValueArray(1), True) |
| If doc_Current Is Nothing Then ' CREATE A BRAND NEW DOCUMENT |
| Set doc_Current = Me.ImportDatabase.CreateDocument |
| For i = Lbound(Me.ImportFields) To Ubound(Me.ImportFields) |
| Call doc_Current.ReplaceItemValue(Me.ImportFields(i), v_ValueArray(i)) |
| Next |
| doc_Current.Form = Me.ImportForm |
| If Me.RefreshForm Then Call doc_Current.ComputeWithForm(False, True) |
| Call doc_Current.Save(True, False) |
| Me.NumAdds = Me.NumAdds + 1 |
| Else ' FOUND A DOCUMENT WITH THE SAME KEY - DETERMINE IF NEED TO UPDATE |
| If Me.SynchronizeDeletions Then |
| Me.SynchUNIDS(doc_Current.UniversalID) = True ' FOUND A DOCUMENT WITH THE SAME KEY - DETERMINE IF NEED TO UPDATE |
| End If |
| v_FieldChange = False |
| For i = Lbound(Me.ImportFields) To Ubound(Me.ImportFields) |
| If Cstr(doc_Current.GetItemValue(Me.ImportFields(i))(0)) <> Cstr(v_ValueArray(i)) Then |
| v_FieldChange = True |
| Call doc_Current.ReplaceItemValue(Me.ImportFields(i), v_ValueArray(i)) |
| End If |
| Next |
| If v_FieldChange Then |
| If Me.RefreshForm Then Call doc_Current.ComputeWithForm(False, True) |
| Call doc_Current.Save(True, False) |
| Me.NumChanges = Me.NumChanges + 1 |
| End If |
| End If |
| End Function |
| |
| Private Function ReturnValueArray(st_LineData) As Variant ' BREAKS UP A LINE OF CSV DATA INTO AN ARRAY |
| Dim i As Integer |
| Dim doc_Current As NotesDocument |
| Dim i_NextDelimiter As Integer |
| Dim v_DoubleQuotes As Variant |
| Dim v_ValueArray(1 To 150) As Variant |
| Dim go_on As Boolean |
| |
| go_on = True |
| i = 1 |
| Do While go_on |
| v_DoubleQuotes = False |
| If Me.QuoteDelimiter = True And Left(st_LineData, 1) = Chr(34) Then ' FOUND A VALUE IN DOUBLE QUOTES |
| i_NextDelimiter = Instr(st_LineData,Chr(34) & Me.Delimiter) ' CLOSING DELIMITER WILL BE ANOTHER SET OF DOUBLE QUOTES + DELIMITER |
| v_DoubleQuotes = True |
| Else |
| i_NextDelimiter = Instr(st_LineData, Me.Delimiter) |
| End If |
| If i_NextDelimiter = 0 Then ' NO DELIMITER FOUND - SO MUST BE LAST VALUE |
| If v_DoubleQuotes Then |
| v_ValueArray(i) = Mid(st_LineData, 2, Len(st_LineData) - 2) ' REMOVE DOUBLE QUOTES |
| Else |
| v_ValueArray(i) = st_LineData |
| End If |
| go_on = False ' will exit the loop then |
| Else |
| If v_DoubleQuotes Then |
| v_ValueArray(i) = Mid(st_LineData, 2, i_NextDelimiter - 2) |
| st_LineData = Trim(Mid(st_LineData, i_NextDelimiter + 2)) |
| Else |
| v_ValueArray(i) = Trim(Left(st_LineData, i_NextDelimiter - 1)) |
| st_LineData = Trim(Mid(st_LineData, i_NextDelimiter + 1)) |
| End If |
| End If |
| Select Case Me.TypeFields(i) |
| Case "Number" : v_ValueArray(i) = Val(v_ValueArray(i)) |
| Case "Date" : v_ValueArray(i) = Datevalue(v_ValueArray(i)) |
| Case "DateTime" : v_ValueArray(i) = Datevalue(v_ValueArray(i))+Timevalue(v_ValueArray(i)) |
| Case "Time" : v_ValueArray(i) = Timevalue(v_ValueArray(i)) |
| End Select |
| If i < Ubound(Me.ImportFields) Then |
| i = i + 1 |
| Else |
| go_on = False |
| End If |
| Loop |
| ReturnValueArray = v_ValueArray |
| End Function |
| End Class |