Hinweis: Am 17.02.2010 nochmal editiert, da ich gleich den nochmal verbesserten Code bereitstellen wollte. Es waren noch keine Antworten zu diesem Eintrag vorhanden.
Grüße, Michael 
Nun, jetzt habe ich die Zeit gefunden, doch noch mal selbst nachzugrübeln (dabei soll man ja am meisten lernen) und an der Stelle gegraben, an der der Fehler auftrat.
Fehler: "Type mismatch on external name CSVFILE" beim Aufruf der Zeile
Set csv = New CSVFile("","FBI", st_Fields, type_Fields)
--> type mismatch. Also muss ein Datentyp beim Aufruf falsch sein. Den einzigen Parameter, welchen ich hinzugefügt habe, ist
type_Fields.
Den Datentype habe ich auf Variant geändert.
Dim type_Fields(1 To 5) As Variant
Siehe da. Der Aufruf funktioniert nun ohne Fehler. Muss blind gewesen sein.
In der Library
ImportCSV habe ich dann noch weitere Änderungen vorgenommen. Vor allem stellte sich heraus, dass man die Felder, welche eben als "Number" gekennzeichnet sind, gleich als Wert ("value", Funktion Val) in das Array
v_ValueArray gespeichert werden sollten.
Schließlich werden die Dokumente auch über den Schlüssel in der ersten Spalte gesucht. Und wenn dies eine Zahl (hier ein Integer) ist, so muss man auch mit einer Zahl und nicht mit einem String suchen.
' LOOKUP THE DOCUMENT
Set doc_Current = vw_Lookup.GetDocumentByKey(v_ValueArray(1), True)
Eigentlich eine Selbstverständlichkeit, aber ich möchte es hier trotzdem erwähnen: Achte bei gebrochenen Zahlen darauf, in welchem Format diese in der CSV-Datei abgespeichert sind. Bei Einstellungen "Deutschland"/"Germany" in den "Regional Settings and Language" werden Zahlen standardmäßig mit Dezimaltrennzeichen "Komma"/"," statt dem "Punkt"/"." geführt. Es sollte darauf geachtet werden, dass gebrochene Zahlen in der CSV-Importdatei mit "Punkt"/"." als Dezimaltrennzeichen geführt werden, denn sonst schneidet die Funktion Val die Nachkommastelle einfach weg.
Inzwischen habe ich den Code weitgehend getestet und dabei festgestellt, dass man in CSV-Dateien zum Import nicht nur Text (String) und Nummern findet, sondern auch noch Datum (Date) und Zeit (Time), aber auch auch Datum und Uhrzeit in einem Feld (DateTime). Dies alles habe ich nun berücksichtigt (siehe case Anweisungen)
Der Code, z.B. in einem Schalter (button):(Options)ClickSub Click(Source As Button)
' 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"
Set csv = New CSVFile("","F_Item", st_Fields, type_Fields)
' if you want to get the records synchronized (compare on actuality of data), then 'true', otherwise 'false'
csv.Synchronize = True
'name of the view which is to be used for the synchronisation
csv.SynchronizeView = "V_Item"
'if you want to get documents deleted as soon as they are missing in CSV file, then 'true', otherwise 'false'
csv.SynchronizeDeletions = True
'which is the delimiter separating the data within CSV file
csv.Delimiter = ";"
csv.NumChanges = 0
csv.NumAdds = 0
csv.NumDeletes = 0
Call csv.Import
End Sub
' 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
Thema: CSV Import mit Abgleich gegen Primärschlüssel, CSV Felder auch als Nummern (Gelesen 6401 mal)