我找到了这个WEKA table to ARFF
file converter 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
答案 0 :(得分:1)
它说“用户定义的类型未定义”,因为应用程序不了解此类/对象,因为它的程序集/命名空间未导入到项目中。 VBA假设默认情况下这是一个用户定义的对象。
您需要在Office文件项目引用中添加对ADODB程序集的引用。我认为这需要Microsoft ActiveX Data Objects x.x Library
,如here所述,但我不确定。
添加引用很简单,只需对组件进行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.