Check if field name exists
This routine will check to see if a field name exists and if it the field name already exists then it will return a field name that does not exist by adding a 1 to the end of the field name.
Function checkIfFieldNameExists(fieldname As String, filename As String) As String
Dim db As database
Dim table As table
Dim field As field
Dim i, j, field_count As Integer
Dim fieldNames() As String 'array to hold the field names
Dim fieldNameOk As Boolean
Dim origFieldName As String
fieldname = UCase(fieldname)
origFieldName = fieldname
Set db = Client.OpenDatabase(filename)
Set table = db.TableDef
field_count = table.count 'get the number for fields
ReDim fieldNames(field_count)
'populate the array to obtain all the field names
For i = 1 To field_count
Set field = table.GetFieldAt(i)
fieldNames(i) = field.name
Next i
j = 1
'loop until we find a fieldname that doesn't exit
Do
For i = 1 To field_count
If fieldname = fieldNames(i) Then
fieldname = origFieldName & j
j = j + 1
fieldNameOk = FALSE
Exit For
Else
fieldNameOk = true
End If
Next i
Loop While fieldNameOk = FALSE
checkIfFieldNameExists = fieldname
Set field = Nothing
Set table = Nothing
Set db = Nothing
End Function
Here is another way to do it using the On Error Resume Next.
Function CheckIfFieldExists(sTempFieldname As String, sTempFileName As String) As String
Dim db As database
Dim table As table
Dim field As field
Set db = Client.OpenDatabase(sTempFileName)
Set table = db.TableDef
err.number = 0 'reset in case of a previous error
On Error Resume Next
Do
Set field = table.GetField(sTempFieldname)
If err.number <> 0 Then
CheckIfFieldExists = sTempFieldname
err.number = 0
GoTo endFunction
Else
sTempFieldname = sTempFieldname & "1"
End If
Loop While True
endFunction:
Set field = Nothing
Set table = Nothing
Set db = Nothing
End Function
Change type of multiply imported xml files
Hi, i created a script, but sometimes its keep running on a error on line 32 on diffrent places. I created a loop because there a more then 100 database files. I can't append them because with the XML import sometimes a field gets the type character and sometimes the type nummeric. I want to build a script to check if a field exists and if so then check is the type is right and if not change it. I thougth i had the solution but it's keep crashing.
Script code
Dim Q1 As Integer
Dim db As database
Dim table As table
Dim field As field
Dim i, j, field_count As Integer
Dim fieldNames() As String
Dim fieldNameOk As Boolean
Dim origFieldName As String
Dim FieldExists As Boolean
Dim FieldNumeric As Boolean
Dim Databasename As String
Dim Field0 As String
Dim Field1 As String
Dim Field2 As String
Dim Check As String
Sub Main
Field0 = "ENDTOENDID"
Field2 = Field0 + "1"
Field1 = Field0
For Q1 = 1 To 101
Databasename = "A (" & Q1 & ").IMD"
'MsgBox "Databasename: " & Databasename
Call checkIfFieldNameExists(Field1, Databasename)
If FieldExists = True Then
'MsgBox "Veld bestaat"
Set db = Client.OpenDatabase("A (" & Q1 & ").IMD")
Set table = db.TableDef
Set field = table.GetField("ENDTOENDID")
FieldNumeric = field.IsNumeric
'MsgBox "Veld is nummeriek: " & FieldNumeric
Set field = Nothing
Set table = Nothing
Set db = Nothing
If FieldNumeric = True Then
'MsgBox "aanpassen"
Call Aanpassen
End If
End If
Client.Closedatabase(Databasename)
Next Q1
End Sub
Function checkIfFieldNameExists(fieldname As String, filename As String) As String
fieldname = UCase(fieldname)
origFieldName = fieldname
Set db = Client.OpenDatabase(Databasename)
Set table = db.TableDef
field_count = table.count
ReDim fieldNames(field_count)
For i = 1 To field_count
Set field = table.GetFieldAt(i)
fieldNames(i) = field.name
Next i
j = 1
Do
For i = 1 To field_count
If fieldname = fieldNames(i) Then
fieldname = origFieldName & j
j = j + 1
fieldNameOk = FALSE
Exit For
Else
fieldNameOk = TRUe
End If
Set field = Nothing
Set table = Nothing
Set db = Nothing'
Next i
Loop While fieldNameOk = FALSE
checkIfFieldNameExists = fieldname
Check = Right(fieldname, 1)
'MsgBox Check
If Check = "1" Then
FieldExists = True
Else
FieldExists = False
End If
'MsgBox FieldExists
End Function
Function Aanpassen
Set db = Client.OpenDatabase(Databasename)
Set task = db.TableManagement
Set field = db.TableDef.NewField
field.Name = Field0
field.Description = ""
field.Type = WI_CHAR_FIELD
field.Equation = ""
field.Length = 16
task.ReplaceField Field0, field
task.PerformTask
Set task = Nothing
Set db = Nothing
Set field = Nothing
End Function
Yes some files doesn't have
Yes some files doesn't have that field. But with the code below it identifies that there is no field. The problem is that when it finds the field in a file, it also says the field is present in the next file while that is not correct. I can't find where the mistake in the code is. My guess is that there is a variable which is not reset to the correct value and holds the value from the previous search with a positive result (field is present). Do you have any idea?
Option Explicit
Dim Q1 As Integer
Dim i, j, field_count As Integer
Dim fieldNames() As String
Dim fieldNameOk As Boolean
Dim origFieldName As String
Dim FieldExists As Boolean
Dim FieldNumeric As Boolean
Dim Databasename As String
Dim Field0 As String
Dim Field1 As String
Dim Field2 As String
Dim Check As String
Sub Main
Dim db As Object
Dim table As Object
Dim field As Object
Field0 = "MNDTID"
Field2 = Field0 + "1"
Field1 = Field0
For Q1 = 131 To 134
Client.CloseAll
Databasename = "A (" & Q1 & ").IMD"
'MsgBox "Databasename: " & Databasename
Call checkIfFieldNameExists(Field1, Databasename)
If FieldExists = True Then
MsgBox "Veld bestaat"
Set db = Client.OpenDatabase("A (" & Q1 & ").IMD")
Set table = db.TableDef
Set field = table.GetField(Field0)
FieldNumeric = field.IsNumeric
'MsgBox "Veld is nummeriek: " & FieldNumeric
Set field = Nothing
Set table = Nothing
Set db = Nothing
If FieldNumeric = True Then
'MsgBox "aanpassen"
Call Aanpassen
End If
Else
MsgBox "Veld bestaat niet"
End If
'MsgBox Databasename & " done"
Set db = Nothing
Set table = Nothing
Set field = Nothing
Client.CloseAll
Next Q1
End Sub
Function checkIfFieldNameExists(fieldname As String, filename As String) As String
Dim db As Object
Dim table As Object
Dim field As Object
fieldname = UCase(fieldname)
origFieldName = fieldname
Set db = Client.OpenDatabase(Databasename)
Set table = db.TableDef
field_count = table.count
ReDim fieldNames(field_count)
For i = 1 To field_count
Set field = table.GetFieldAt(i)
fieldNames(i) = field.name
Next i
j = 1
Do
For i = 1 To field_count
If fieldname = fieldNames(i) Then
fieldname = origFieldName & j
j = j + 1
fieldNameOk = FALSE
Exit For
Else
fieldNameOk = TRUe
End If
Set field = Nothing
Set table = Nothing
Set db = Nothing'
Next i
Loop While fieldNameOk = FALSE
checkIfFieldNameExists = fieldname
Check = Right(fieldname, 1)
If Check = "1" Then
FieldExists = True
Else
FieldExists = False
End If
Set db = Nothing
Set table = Nothing
Set field = Nothing
End Function
Function Aanpassen
Dim db As Object
Dim task As Object
Dim field As Object
Set db = Client.OpenDatabase(Databasename)
Set task = db.TableManagement
Set field = db.TableDef.NewField
field.Name = Field0
field.Description = ""
field.Type = WI_CHAR_FIELD
field.Equation = ""
field.Length = 16
task.ReplaceField Field0, field
task.PerformTask
Set task = Nothing
Set db = Nothing
Set field = Nothing
End Function
Hi Robert,
Hi Robert,
What you need to do is at the bottom of where you are writing your comment you should see something that says Disable rich-text, this will allow you to past in html code. Click on that link and before you paste in your ideascript enter this:
<pre><code>
.... paste in IDEAScript code
</code></pre>
then click on enable rich-text and that will hopefully keep the indents and such.
Is it possible to add a
Is it possible to add a boolean to contain the result if the field exists or not?