Программа VBA для преобразования таблицы в ARFF возвращает "Определяемый пользователем тип не определен"
Я нашел этот стол WEKA, чтобы ARFF Конвертер файлов VBA скрипт. Я ничего не знаю о программировании на VBA, и я просто хочу использовать этот файл, чтобы помочь мне в моих исследованиях.
Я попытался запустить его в моей программе MS Access 2007, но "ошибка компиляции" с сообщением User-defined type not defined показывает и выделяет линию
Dim rs As ADODB.Recordset
Вот весь сценарий для всех, кто интересуется:
Option Compare Database
Option Explicit
'Created by Ashutosh Nandeshwar: a7n9 AT Yahoo
'Use this procedure to convert Access Tables to ARFF data format
'Some highlights of this procedure
' - Takes care of spaces in Attribute name and data values
' - Finds unique values of nominal variables
' - Assigns equivalent ARFF datatype
' - Replaces missing values with question marks
Sub ConvertTbl2Arff()
On Error GoTo ConvertTbl2Arff_Error
'--------------------Declarations Area-----------------
Dim sTblName As String
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim fld As ADODB.Field
Dim sFileName As String
Dim iOPFile As Integer
Dim sInstance As String, sVal As String
Dim vStart As Variant
'--------------------Declarations End-------------------
'Enter the table name to convert to ARFF
sTblName = InputBox("Enter table name", , "weather")
'Do the basic ADO stuff
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
'Open the table using ADO
rs.Open sTblName, cn, adOpenStatic, adLockReadOnly, adCmdTable
vStart = Timer ' Note start time
'Create the file name using table name and current path
sFileName = Application.CurrentProject.Path & Chr(92) & sTblName & ".arff"
iOPFile = FreeFile 'Assign an avaialble freefile number to a variable
Open sFileName For Output As iOPFile 'Open a file for output
'Print the first line of ARFF- @relation
Print #iOPFile, "@relation " & sTblName
'Start a loop to print all the attribute names
'The function FieldType takes care of nominal, boolean, numeric and string variables
'If it is a string variable programs asks if it is a nominal variable, if it is a nominal
'variable then a SQL query is run to get the unique values
For Each fld In rs.Fields
Print #iOPFile, "@attribute " & TrimAll(fld.Name) & Chr(32) & FieldType(fld.Type, sTblName, fld.Name)
Next
'Print the @data line
Print #iOPFile, "@data"
'Run a loop thru all the records to print the records
'Chr(63)="?" Chr(44)= ","
Do Until rs.EOF
sInstance = ""
For Each fld In rs.Fields
sVal = IfNull(fld.value, "?")
If sVal <> Chr(63) Then
sInstance = sInstance & IfSpace(sVal) & Chr(44)
Else
sInstance = sInstance & sVal & Chr(44)
End If
Next
Print #iOPFile, Left(sInstance, Len(sInstance) - 1) 'Prints each instance
rs.MoveNext ' Move to next record
Loop
MsgBox "Succesfully converted an Access table to ARFF file-" & vbCrLf & _
sFileName & vbCrLf & _
"Time taken: " & Timer - vStart & " seconds."
'Make a clean exit
ConvertTbl2Arff_CleanUpExit:
Close iOPFile
If Not rs Is Nothing Then
If rs.State = adStateOpen Then rs.Close
End If
Set rs = Nothing
If Not cn Is Nothing Then
If cn.State = adStateOpen Then cn.Close
End If
Exit Sub
'Error handling
ConvertTbl2Arff_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ConvertTbl2Arff", vbInformation
Resume ConvertTbl2Arff_CleanUpExit
End Sub
'Find the Access table field types and return equivalent ARFF data types
Public Function FieldType(intType As Integer, sTblNm As String, sFldNm As String) As String
Dim strSQl As String
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
On Error GoTo FieldType_Error
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
Select Case intType
Case adBigInt, adBinary, adBSTR, adChar, adLongVarBinary, adLongVarChar, adLongVarWChar, adVarChar, adVarWChar, adWChar
Select Case MsgBox("Is variable " & sFldNm & " a nominal variable?", vbYesNo Or vbQuestion Or vbDefaultButton1, "Nominal Variable")
Case vbYes
strSQl = "SELECT [" & sFldNm & "]"
strSQl = strSQl & " FROM [" & sTblNm & "]"
strSQl = strSQl & " GROUP BY [" & sFldNm & "];"
rs.Open strSQl, cn
FieldType = Chr(123)
Do Until rs.EOF
If Not IsNull(rs.Fields(0)) Then
FieldType = FieldType & IfSpace(rs.Fields(0)) & Chr(44)
End If
rs.MoveNext
Loop
FieldType = Left(FieldType, Len(FieldType) - 1)
FieldType = FieldType & Chr(125)
Case vbNo
FieldType = "string"
End Select
Case adBigInt, adDecimal, adDouble, adInteger, adNumeric, adSmallInt, adTinyInt, adUnsignedBigInt, adUnsignedInt, adUnsignedSmallInt, adUnsignedTinyInt, adVarNumeric
FieldType = "numeric"
Case adDate, adDBDate, adDBTime
FieldType = "Date"
Case adBoolean
FieldType = "{True, False}"
End Select
FieldType_CleanUpExit:
If Not rs Is Nothing Then
If rs.State = adStateOpen Then rs.Close
End If
Set rs = Nothing
If Not cn Is Nothing Then
If cn.State = adStateOpen Then cn.Close
End If
Exit Function
FieldType_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FieldType", vbInformation
Resume FieldType_CleanUpExit
End Function
'If the field value is Null replace it with optional NullValue, in this case a ?
Public Function IfNull(value As Variant, Optional NullValue As Variant = "") As Variant
If IsNull(value) Or Len(Trim(value)) = 0 Then
IfNull = NullValue
Else
IfNull = value
End If
End Function
'Remove special chars from a string
Public Function TrimAll(sString As String)
Dim sResult As String, l As Long
sResult = sString
For l = 32 To 47
sResult = Replace(sResult, Chr(l), "")
Next l
For l = 58 To 64
sResult = Replace(sResult, Chr(l), "")
Next l
For l = 91 To 96
sResult = Replace(sResult, Chr(l), "")
Next l
For l = 123 To 127
sResult = Replace(sResult, Chr(l), "")
Next l
TrimAll = sResult
End Function
'If there is a space in given string return a string with quotations around it
'Chr(34)=""
Public Function IfSpace(sString As String) As String
Dim sResult As String, sResStr As String
sResStr = TrimAll(sString)
If Len(sResStr) <> Len(sString) Then
sResult = Chr(34) & sString & Chr(34)
Else
sResult = sString
End If
IfSpace = sResult
End Function
1 ответ
Решение
В нем говорится "Определяемый пользователем тип не определен", поскольку приложение не знает об этом классе / объекте, поскольку его сборка / пространство имен не импортируется в проект. VBA просто предполагает, что это пользовательский объект по умолчанию.
Вам нужно будет добавить ссылку на сборку ADODB в ссылках проекта Office File. Я считаю это требует Microsoft ActiveX Data Objects x.x Library как указано здесь, но я не уверен.
Добавить ссылки просто, чтобы сделать Visual Basic ссылкой на компонент:
1. On the Project menu, click References.
2. Click to select the check box next to the component(s) you want to add.
3. Click OK.