none
ERR=458, Variable uses an Automation type not supported in Visual Basic RRS feed

  • Question

  • Hi

    I am using this for many years, now for the first time error

    function adds new item to var-array

    For example:   AA_ADD_ITEM_1D   MyArray,"new-array-item"

    la_FILES() As String, lc_file_XLS As String
    AA_ADD_ITEM_1D la_FILES, lc_file_XLS

    LBL_xPAC_END:
        AddArray_Return = lvRet '<-----ERROR

    AddArray_Return = lvRet
    ? ERR,ERR.Description
     ......................ERR=458,Variable uses an Automation type not supported in Visual Basic
    ?..................... VARTYPE(AddArray_Return) ' locals: Variant/String()
     8200 (?...in VBA not exists)
    ?...................... VARTYPE(LVRET)' locals: Variant/Variant(0 to 0)
     8204 (?...in VBA not exists)
    ? ......................VARTYPE(lvRET_INI)
     8204 (?...in VBA not exists)

    What may be wrong ? iconfused.gif

    Public Sub AA_ADD_ITEM_1D(AddArray_Return As Variant, ArItem, Optional bNoDuplicate As Boolean = False, _
        Optional bSeekSubString As Boolean = False, Optional Compare As VbCompareMethod = vbTextCompare, _
        Optional bAddEmpty As Boolean = True)
    On Error GoTo LBL_xPAC_ERR
    Dim llRet As Boolean, lnXUAsk As Long, lcXName As String, lcXUser As String, ll_ADD As Boolean
    Dim iArlen As Long, iArDimMAX As Long, lvRet As Variant, lvRET_INI(), iArMin As Long, iArMAX As Long
    lcXName = "AA_ADD_ITEM_1D"
    iArDimMAX = AA_DIMS_CNT(AddArray_Return)
    If (iArDimMAX < 2) Then
        If (iArDimMAX = 1) Then lvRet = AddArray_Return
        iArlen = AA_DIMS_LEN(lvRet)
        If Not bAddEmpty Then If IS_EMPTY(ArItem) Then GoTo LBL_xPAC_END
        If (iArlen > 0) Then
            iArMAX = UBound(lvRet)
            iArMin = LBound(lvRet)
        Else
            iArMAX = -1
            iArMin = 0
            lvRet = lvRET_INI
        End If
        ll_ADD = True
        If bNoDuplicate Then If iArlen > 0 And AA_SEEK(lvRet, ArItem, , bSeekSubString, Compare) Then ll_ADD = False
        If ll_ADD Then
            ReDim Preserve lvRet(iArMin To iArMAX + 1)
            lvRet(iArMAX + 1) = ArItem
            llRet = True
        End If
    End If
    LBL_xPAC_END:
        AddArray_Return = lvRet
        Erase lvRET_INI
    Exit Sub
    LBL_xPAC_ERR:
    lnXUAsk = ERROR_SHOW(Err, cErrDescUser:=lcXUser, cErrProcName:=lcXName & "." & lkCurModul_NV)
    Select Case lnXUAsk: Case 1: Resume: Case 2: Resume Next: Case Else: On Error Resume Next: Resume LBL_xPAC_END: End Select
    End Sub


    dBase,FoxPro,MS Access 2003,(2010=Not rec.),Office 2010+ACC.2013 ,Symbian C++, AC.2013.SystemResource.GetCurrentFreeSize=?


    • Edited by PACALA_BA Tuesday, October 13, 2015 1:17 PM
    Tuesday, October 13, 2015 1:14 PM

Answers

  • rescue :-)..............REBUILD TO NEW ONE DB

    It works OK, without any ++unexplainable++errors

    (I am using this for +++many years+++, now for the first time error)

    I am continue using the same again.....:-)

    ? VARTYPE(AddArray_Return)
     0 .............................OK
    ? VARTYPE(lvRet)
     8204............................OK

    ?............. VARTYPE(AddArray_Return) ' locals: Variant/String()
     8200 (?...in VBA not exists)


    dBase,FoxPro,MS Access 2003,(2010=Not rec.),Office 2010+ACC.2013 ,Symbian C++, AC.2013.SystemResource.GetCurrentFreeSize=?


    • Marked as answer by PACALA_BA Wednesday, October 14, 2015 3:23 PM
    • Edited by PACALA_BA Wednesday, October 14, 2015 3:32 PM
    Wednesday, October 14, 2015 3:23 PM

All replies

  • Several functions are missing so I cannot run your code. Speculating I think MyArray is undefined or an array of an unusual type.

    -Tom. Microsoft Access MVP

    Tuesday, October 13, 2015 1:47 PM
  • Thx, try it..

    Sub TEST_ERROR()
    Dim la_FILES() As String, lc_file_XLS As String
    lc_file_XLS = "ABC"
    AA_ADD_ITEM_TEST la_FILES, lc_file_XLS
    End Sub
    Public Sub AA_ADD_ITEM_TEST(AddArray_Return As Variant, ArItem, Optional bNoDuplicate As Boolean = False, _
        Optional bSeekSubString As Boolean = False, Optional Compare As VbCompareMethod = vbTextCompare, _
        Optional bAddEmpty As Boolean = True)
    On Error GoTo LBL_xPAC_ERR
    Dim llRet As Boolean, lnXUAsk As Long, lcXName As String, lcXUser As String, ll_ADD As Boolean
    Dim iArlen As Long, iArDimMAX As Long, lvRet As Variant, lvRET_INI(), iArMin As Long, iArMAX As Long
    lcXName = "AA_ADD_ITEM_1D"
    iArDimMAX = 0 'AA_DIMS_CNT(AddArray_Return)
    If (iArDimMAX < 2) Then
        If (iArDimMAX = 1) Then lvRet = AddArray_Return
        iArlen = -1 ' AA_DIMS_LEN(lvRet)
        'If Not bAddEmpty Then If IS_EMPTY(ArItem) Then GoTo LBL_xPAC_END
        If (iArlen > 0) Then
            iArMAX = UBound(lvRet)
            iArMin = LBound(lvRet)
        Else
            iArMAX = -1
            iArMin = 0
            lvRet = lvRET_INI
        End If
        ll_ADD = True
        If ll_ADD Then
            ReDim Preserve lvRet(iArMin To iArMAX + 1)
            lvRet(iArMAX + 1) = ArItem
            llRet = True
        End If
    End If
    LBL_xPAC_END:
        AddArray_Return = lvRet
        Erase lvRET_INI
    Exit Sub
    LBL_xPAC_ERR:
    MsgBox Err & "," & Err.Description
    Resume Next
    Resume
    End Sub


    dBase,FoxPro,MS Access 2003,(2010=Not rec.),Office 2010+ACC.2013 ,Symbian C++, AC.2013.SystemResource.GetCurrentFreeSize=?

    Tuesday, October 13, 2015 1:59 PM
  • I think you'll have to rewrite the code and be more explicit about the datatypes. Remove all variants and use string arrays.

    -Tom. Microsoft Access MVP

    Tuesday, October 13, 2015 2:09 PM
  • I am using this for +++many years+++, now for the first time error

    'OFF...Dim lvRet As Variant, lvRET_INI()
    Dim lvRet() As String, lvRET_INI() As String........................OK

    Thx


    dBase,FoxPro,MS Access 2003,(2010=Not rec.),Office 2010+ACC.2013 ,Symbian C++, AC.2013.SystemResource.GetCurrentFreeSize=?

    • Marked as answer by PACALA_BA Tuesday, October 13, 2015 2:42 PM
    • Unmarked as answer by PACALA_BA Wednesday, October 14, 2015 3:19 PM
    Tuesday, October 13, 2015 2:42 PM
  • > I am using this for +++many years+++, now for the first time error

    I understand that, and it can be frustrating. But put yourself in MSFT's position when you have found a vulnerability with the language. Maybe something sloppy you were allowing that really should not be. Fix it? Not?

    If we look over many years and many versions we can see a move by MSFT towards stricter interpretation. Maybe you finally got caught by it, but in hindsight your code shouldn't have compiled YEARS ago.

    I don't want to be a MSFT apologist, but I can certainly understand that sometimes decisions have to be made that break existing code. That's when programmers like Pacala and Tom come to the rescue :-)


    -Tom. Microsoft Access MVP

    Wednesday, October 14, 2015 5:35 AM
  • rescue :-)..............REBUILD TO NEW ONE DB

    It works OK, without any ++unexplainable++errors

    (I am using this for +++many years+++, now for the first time error)

    I am continue using the same again.....:-)

    ? VARTYPE(AddArray_Return)
     0 .............................OK
    ? VARTYPE(lvRet)
     8204............................OK

    ?............. VARTYPE(AddArray_Return) ' locals: Variant/String()
     8200 (?...in VBA not exists)


    dBase,FoxPro,MS Access 2003,(2010=Not rec.),Office 2010+ACC.2013 ,Symbian C++, AC.2013.SystemResource.GetCurrentFreeSize=?


    • Marked as answer by PACALA_BA Wednesday, October 14, 2015 3:23 PM
    • Edited by PACALA_BA Wednesday, October 14, 2015 3:32 PM
    Wednesday, October 14, 2015 3:23 PM