Hello
i need some help i have made a function that it works but i need some help. The Function imports an excel into a tempary table then i want to make some checks before i import them to the main table
all checks work great except one if every field has the right type of value
and if the field has the wrong type insert a message at the errors field next to the wrong row
here is the code
i need some help i have made a function that it works but i need some help. The Function imports an excel into a tempary table then i want to make some checks before i import them to the main table
all checks work great except one if every field has the right type of value
and if the field has the wrong type insert a message at the errors field next to the wrong row
here is the code
Code:
Dim sqli As String
Dim find_Client
Dim sqlL As String
Dim IsTable As Boolean
'elenxoume an uparxei o pinakas Field names
'an uparxei ton diagrafoume
'dimourgoume ton pinaka Fieldnames
B0001_Check_Table ("FieldNames")
sqli = "create table FieldNames (name text, type text);"
DoCmd.RunSQL sqli
Dim db As Database
Dim rs1 As Recordset
Dim sql2 As String
Dim find_type
Dim flag As Integer
Dim a As Integer
Dim ss, nn
Dim Field_name As String
a = 0
Set db = CurrentDb()
Set rs1 = db.OpenRecordset("myNewTable")
'Dim rsTester
'Set rsTester = db.OpenRecordset("myNewTable", dbOpenDynaset)
Dim fld As DAO.Field
For Each fld In rs1.Fields
ss = FieldType(fld.Type)
Field_name = fld.Name
'diabazoume ton tupo ton pedion
Select Case Field_name
Case "Client Code"
'
' If rsTester("Client Code").Type <> dbInteger Then
' MsgBox "1" ' do the thing
' Else
' MsgBox "2" ' do the other thing
' End If
'
'
Case "Received No"
Case "Invoice Date"
Case "Amount"
Case "Remarks"
Case "F6", "F7", "F8", "F9", "F10", "F11", "F12", "F13", "F14", "F15", "F16", "F17"
Case "F18", "F19", "F20", "F21", "F22", "F23", "F24", "F25", "F26", "F27", "F28", "F29"
Case "Errors"
Case Else
MsgBox "field " & fld.Name & " does not exist make sure that the excel file that you try to insert is the correct one "
a = 1
rs1.Close
B0001_Check_Table ("myNewTable")
B0001_Check_Table ("FieldNames")
Exit Function
End Select
Dim sqlalter As String
Dim SqlInsertErrors
sql2 = "Insert into FieldNames (name,type) values ('" & fld.Name & "','" & ss & "');"
DoCmd.RunSQL sql2
Next
rs1.Close
Set fld = Nothing
Dim Error2 As Boolean
Error2 = B0001_FieldExists("myNewTable", "Errors")
Set db = CurrentDb()
Set rs1 = db.OpenRecordset("myNewTable")
For Each fld In rs1.Fields
ss = FieldType(fld.Type)
' elenxoume ton tupo ton pedion
Dim crl As Control
Field_name = fld.Name
Select Case Field_name
Case "Client Code"
find_type = DLookup("name", "FieldNames", "name = '" & Field_name & "' and type = 'dbDouble'")
If IsNull(find_type) Then
' MsgBox fld.Name & " has wrong type"
SqlInsertErrors = "insert into myNewTable (Errors) values ('" & fld.Name & " has wrong type') ;"
DoCmd.RunSQL SqlInsertErrors
a = 2
End If
Case "Received No"
find_type = DLookup("name", "FieldNames", "name = '" & Field_name & "' and type = 'dbDouble'")
If IsNull(find_type) Then
' MsgBox fld.Name & " has wrong type"
SqlInsertErrors = "insert into myNewTable (Errors) values ('" & fld.Name & " has wrong type') ;"
DoCmd.RunSQL SqlInsertErrors
a = 3
End If
Case "Invoice Date"
find_type = DLookup("name", "FieldNames", "name = '" & Field_name & "' and type = 'dbDate'")
If IsNull(find_type) Then
' MsgBox fld.Name & " has wrong type"
SqlInsertErrors = "insert into myNewTable (Errors) values ('" & fld.Name & " has wrong type') ;"
DoCmd.RunSQL SqlInsertErrors
a = 4
End If
Case "Amount"
find_type = DLookup("name", "FieldNames", "name = '" & Field_name & "' and type = 'dbDouble'")
If IsNull(find_type) Then
' MsgBox fld.Name & " has wrong type"
SqlInsertErrors = "insert into myNewTable (Errors) values ('" & fld.Name & " has wrong type') ;"
DoCmd.RunSQL SqlInsertErrors
a = 5
End If
Case "Remarks"
find_type = DLookup("name", "FieldNames", "name = '" & Field_name & "' and type = 'dbText'")
If IsNull(find_type) Then
' MsgBox fld.Name & " has wrong type"
SqlInsertErrors = "insert into myNewTable (Errors) values ('" & fld.Name & " has wrong type') ;"
DoCmd.RunSQL SqlInsertErrors
a = 6
End If
Case "F6"
Case "F7", "F8", "F9", "F10", "F11", "F12", "F13", "F14", "F15", "F16", "F17"
Case "F18", "F19", "F20", "F21", "F22", "F23", "F24", "F25", "F26", "F27", "F28", "F29"
Case "Errors"
Case Else
MsgBox "field " & fld.Name & " does not exist "
End Select
Next
rs1.Close
Set fld = Nothing
Dim rs2 As Recordset
Dim i As Integer
Dim sqlErrorReport
i = 1
Set rs2 = CurrentDb.OpenRecordset("select myNewTable.* from myNewTable")
Dim temp
Dim find_null_records
'Check to see if the recordset actually contains rows
If Not (rs2.EOF And rs2.BOF) Then
rs2.MoveFirst 'Unnecessary in this case, but still a good habit
Do Until rs2.EOF = True
'elenxei an uparxei to o client kai ola ta upolipa pedia einai sumpliromena
If ((Not IsNull(rs2![Client Code]) And ((IsNull(rs2![Received No])) Or (IsNull(rs2![Invoice Date])) Or (IsNull(rs2!Amount))))) Then
' MsgBox "there is a record with null value "
'rs2!Error = "record has a null value"
a = 7
End If
'elenxei an exei exei ksexasei na balei client code
If ((IsNull(rs2![Client Code]) And ((Not IsNull(rs2![Received No])) Or (Not IsNull(rs2![Invoice Date])) Or (Not IsNull(rs2!Amount))))) Then
'MsgBox "there is a record with Client code null value "
'rs2!Error = "record has null Client Code"
a = 8
End If
temp = rs2![Client Code]
If IsNull(temp) Then
'elenxoume an ola ta pedia einai kena
'an einai ta afinoume na perasoun
If ((IsNull(rs2![Client Code]) And (IsNull(rs2![Received No])) And (IsNull(rs2![Invoice Date])) And (IsNull(rs2!Amount)))) Then
GoTo next_temp
End If
End If
' elenxei an to client id uparxei ston pinaka client
If Not IsNull(temp) Then
find_Client = DLookup("ClientID", "Clients", "ClientID = " & temp & "")
If IsNull(find_Client) Then
' MsgBox "Client " & rs2![Client Code] & " does not exist "
slq_U = "Update myNewTable set myNewTable.[Errors] ='This Client ID does not exist' where (myNewTable.[Client Code] = " & temp & ");"
' Debug.Print slq_U
DoCmd.RunSQL slq_U
a = 9
ElseIf Not IsNull(find_Client) Then
End If
End If
Dim sqlDN As String
sqlDN = ""
'elexnei an uparxei i idia engafi mesa ston pinaka
Dim Find_Duplicate_Records
next_temp:
rs2.MoveNext
Loop
Else
' MsgBox "There are no records in the recordset."
End If
rs2.Close 'Close the recordset
Set rs2 = Nothing 'Clean up
'update myNewtable with the errors
slq_U = "Update myNewTable set myNewTable.[Errors] ='record has null Client Code' where ((myNewTable.[Client Code] is null) and (myNewTable.[Received No] is not null) and ( myNewTable.[Invoice Date] is not null ) and (myNewTable.Amount is not null) ) ;"
' Debug.Print slq_U
DoCmd.RunSQL slq_U
slq_U = "Update myNewTable set myNewTable.[Errors] ='record has null Value' where ((myNewTable.[Client Code] is not null) and ((myNewTable.[Received No] is null) or ( myNewTable.[Invoice Date] is null ) or (myNewTable.Amount is null) )) ;"
' Debug.Print slq_U
DoCmd.RunSQL slq_U
Dim rs4 As Recordset
i = 0
Set rs4 = CurrentDb.OpenRecordset("myNewTable")
If Not (rs4.EOF And rs4.BOF) Then
rs4.MoveFirst 'Unnecessary in this case, but still a good habit
Do Until rs4.EOF = True
If Not IsNull(rs4![Client Code]) Then
' If IsNull(rs4![Invoice Date]) Then
'
' Find_Duplicate_Records = DLookup("[Pay_ClientID]", "New_PaymentS", "[Pay_ClientID] = " & rs4![Client Code] & " and Pay_Parast ='" & rs4![Received No] & "' and isnull(" & rs4![Invoice Date] & ")")
'
If Not IsNull(rs4![Invoice Date]) Then
Find_Duplicate_Records = DLookup("[Pay_ClientID]", "New_PaymentS", "[Pay_ClientID] = " & rs4![Client Code] & " and Pay_Parast ='" & rs4![Received No] & "' and Pay_InvDate = " & Format(rs4![Invoice Date], "\#mm\/dd\/yyyy\#") & "")
End If
If Not IsNull(Find_Duplicate_Records) Then
a = 10
''''''''''''
If Not IsNull(rs4![Invoice Date]) Then
slq_U = "Update myNewTable set myNewTable.[Errors] ='record already exists' where myNewTable.[Client Code] = " & rs4![Client Code] & " and myNewTable.[Received No] =" & rs4![Received No] & " and myNewTable.[Invoice Date] = " & Format(rs4![Invoice Date], "\#mm\/dd\/yyyy\#") & " ;"
DoCmd.RunSQL slq_U
End If
''''''''''''
End If
End If
rs4.MoveNext
Loop
Else
' MsgBox "There are no records in the recordset."
End If
rs4.Close
If a = 0 Then
