문제

I found this WEKA table to ARFF file converter VBA script. I know nothing about VBA programming and I just want to use this file to help me in my research.

I tried running it into my MS Access 2007 program but a "Compile error" with the message User-defined type not defined shows and highlights the line

Dim rs As ADODB.Recordset

Here is the whole script for anyone interested:

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
도움이 되었습니까?

해결책

It says "User-defined type not defined" becuase the application does not know about this class/object since its assembly/namespace is not imported into the project. VBA just assumes this is a user defined object by default.

You will need to add a reference to the ADODB assembly in your Office File project references. I believe this requires Microsoft ActiveX Data Objects x.x Library as stated here, but I am not certain.

Adding references is simple, to make a Visual Basic reference to a component:

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.
라이센스 : CC-BY-SA ~와 함께 속성
제휴하지 않습니다 StackOverflow
scroll top