Results 1 to 5 of 5
  1. #1
    SYFYLADY is offline Novice
    Windows 7 64bit Access 2007
    Join Date
    Mar 2014
    Location
    Arizona
    Posts
    3

    Application-defined or object-defined error

    I recently inherited this data base from the DBManger who quit, I was the data entry person, now the acting manager. The first half, in Blue, strips an Excel file and reconfigures it. That part works great. The second half imports it into the Access table. It works with files that are less than 13000 lines but I keep getting different errors or it just cuts that data off when importing a 16000 line file at around line 14500. The Excell sheet looks good and is stripped out correctly. I thought the line in red was the problem but that is just a comment so it should have no bearing.

    Private Sub CmdBOMImport_Click()
    On Error GoTo Err_CmdBOMImport_Click
    DoCmd.SetWarnings False
    Call ImportBOMs

    DoCmd.SetWarnings False
    DoCmd.OpenQuery "qryBOM_Blanks"
    DoCmd.OpenQuery "qryBOM_RevUpdate"
    DoCmd.SetWarnings True
    MsgBox "BOM Import Complete", vbOKOnly, "All Done"
    Exit_CmdBOMImport_Click:
    Exit Sub
    Err_CmdBOMImport_Click:
    MsgBox Err.Description
    Resume Exit_CmdBOMImport_Click

    End Sub


    Public Sub ImportBOMs()
    DoCmd.SetWarnings False
    Dim strSQL As String
    Dim strFilter As String
    Dim strInputFileName As String
    Dim Msg As String
    'Open file dialog box to choose file to import
    strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")
    strInputFileName = ahtCommonFileOpenSave( _
    Filter:=strFilter, OpenFile:=True, _
    DialogTitle:="Please select an input file...", _
    Flags:=ahtOFN_HIDEREADONLY)

    'Clean up selected Bom for import

    'Formly known as BOMLgFormat()in Excel

    ' Msg = "Assumes the initial excel format data in these locations: [tobe] indicates new location after subprogram" & (Chr(13)) & _
    '"BOM Sort - Column A BOM Sort Sequence stating at 0" & (Chr(13)) & _
    '"Level - Column B BOM Indent Level" & (Chr(13)) & _
    '"Find Number - Column D [tobe C] Drawing Find Number" & (Chr(13)) & _
    '"Part Number - Column G [tobe D] Component Past Number" & (Chr(13)) & _
    '"Description - Column H [tobe E]" & (Chr(13)) & _
    '"Rev - A11 [tobe F2]" & (Chr(13)) & _
    '"Quantity (per) - Column K [tobe G]" & (Chr(13)) & _
    '"Cage Code - Column L [tobe H]" & (Chr(13)) & _
    '"Lead Time - Column M [tobe I]" & (Chr(13)) & _
    '"Design Date - Column T [tobe J]" & (Chr(13)) & _
    '"Next Higher Assy NHA - A10 [tobe K]" & (Chr(13)) & _
    '"Designation - G10 [tobe L]" & (Chr(13)) & _


    ' MsgBox Msg, vbOKOnly, "Check Format"
    Dim xlApp As Excel.Application
    Dim xlBook As Object
    Dim xlSheet As Object
    Dim i As Long
    Dim LastRow As Long
    Dim line As Long
    Dim b As Object
    Dim Lrow As Long
    Dim Acell As Object
    'Open Excel & Open the file so we can play with it
    Set xlApp = New Excel.Application
    Set xlBook = xlApp.Workbooks.Open(strInputFileName)
    Set xlSheet = xlApp.ActiveWorkbook.Worksheets(1)
    xlApp.Visible = True

    'Make the top level part number level 0 part number
    With xlSheet.Application
    xlSheet.Rows(13).EntireRow.Insert

    ' xlSheet.Rows("13:13").Select
    ' xlSheet.ActiveCell.EntireRow.Insert

    ' xlSheet.Selection.Insert Shift:=xlSheet.xlDown, CopyOrigin:=xlSheet.xlFormatFromLeftOrAbove
    ' xlSheet.Range("13:13").Select
    'xlSheet.Range("A:13").Activate
    'xlSheet.Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove



    xlSheet.Range("A13").value = 0
    xlSheet.Range("B13").Select
    xlSheet.Range("B13").FormulaR1C1 = 0
    ' xlSheet.Range("G13").Select
    xlSheet.Range("G13").FormulaR1C1 = "=TRIM(RIGHT(R[-8]C[-6],14))"
    ' xlSheet.Range("H13").Select
    xlSheet.Range("H13").FormulaR1C1 = _
    "=TRIM(MID(R[-3]C[-1],FIND("":"",R[-3]C[-1],1)+1,250))"
    xlSheet.Range("I13").Select
    xlSheet.Range("I13").FormulaR1C1 = "=RIGHT(R[-2]C[-8],1)"
    ' xlSheet.Range("K13").Select
    xlSheet.Range("K13").FormulaR1C1 = "1"
    ' xlSheet.Rows("13:13").Select
    xlSheet.Range("13:13").Copy
    xlSheet.Range("13:13").PasteSpecial Paste:=xlPasteValues
    'xlSheet.Range("1:11").Select
    ' xlSheet.Range("X1").Activate
    ' xlSheet.Application.CutCopyMode = False
    xlSheet.Range("1:11").Delete Shift:=xlUp
    'Get rid of the unwanted columns
    'xlSheet.Range("C:C,E:F,J:J,N:S,U:W").Select
    'xlSheet.Range("U1").Activate
    xlSheet.Range("C:C,E:F,J:J,N:S,U:W").EntireColumn. Delete xlShiftToLeft

    ' xlSheet.Rows(13).EntireRow.Insert
    'xlSheet.Columns("C:C,E:F,J:J,N:S,U:W").EntireColu mn.Delete Shift:=xlSheet.xlToLeft
    'Format Columns

    xlSheet.Columns("H:H").NumberFormat = "@"
    xlSheet.Columns("J:J").NumberFormat = "m/d/yyyy"
    xlSheet.Columns("I:I").NumberFormat = "0"
    xlSheet.Columns("C:C").NumberFormat = "@"
    xlSheet.Columns("A:A").NumberFormat = "0"

    'Insert column label (field names)


    xlSheet.Cells(1, 1).Activate
    xlSheet.Columns("A:A").Select
    xlSheet.Cells(1, 1).value = "BOM"
    xlSheet.Cells(1, 2).value = "Level"
    xlSheet.Cells(1, 3).value = "FN"
    xlSheet.Cells(1, 4).value = "Component Part"
    xlSheet.Cells(1, 5).value = "Component Description"
    xlSheet.Cells(1, 6).value = "Rev"
    xlSheet.Cells(1, 7).value = "Qty"
    xlSheet.Cells(1, 8).value = "Cage Code"
    xlSheet.Cells(1, 9).value = "Lead Time"
    xlSheet.Cells(1, 10).value = "Design Date"
    xlSheet.Cells(1, 11).value = "NHA"
    xlSheet.Cells(1, 12).value = "Designation"


    'For Each Acell In Selection
    ' Acell.value = CDec(Acell.value)
    ' Next Acell


    ' assign values to the variables - where does the data end?
    Lrow = xlSheet.Range("b" & xlSheet.Rows.Count).End(xlUp + 1).Row
    LastRow = xlSheet.Cells.SpecialCells(xlCellTypeLastCell).Row

    i = 3
    line = 0
    xlSheet.Range("A1:Z" & LastRow).MergeCells = False
    xlSheet.Columns("B:B").SpecialCells(xlCellTypeBlan ks).EntireRow.Delete
    xlSheet.Columns("M:XFD").EntireColumn.Delete
    xlSheet.Rows(Lrow & ":1048576").EntireRow.Delete


    xlSheet.Range("B3:B" & LastRow) = xlSheet.Range("B3:B" & LastRow).value
    xlSheet.Cells(3, 12).FormulaR1C1 = "=IF(RC[-10]=1,RC[-7],R[-1]C)"
    Dim RngFormula As Range
    xlSheet.Range("L3:L" & LastRow).FillDown

    ' xlSheet.Selection.FillDown

    'Next Higher Assembly - looks at level and determines if current level is lower, higher, or equal to the line above it and records the NHA part number
    While i < LastRow

    Line1:
    line = line + 1
    For Each b In xlSheet.Cells.CurrentRegion 'ActiveCell.CurrentRegion.Cells

    If xlSheet.Cells(i - line, 2).value < xlSheet.Cells(i, 2).value Then
    xlSheet.Cells(i, 11).value = xlSheet.Cells(i - line, 4)

    ElseIf xlSheet.Cells(i - line, 2).value > xlSheet.Cells(i, 2).value Then
    GoTo Line1

    Else
    xlSheet.Cells(i, 11).value = xlSheet.Cells(i - line, 11).value

    End If

    If i = LastRow Or i > LastRow Then
    Exit For


    Else
    i = i + 1
    End If

    line = 1

    xlSheet.Cells(i, 2).Activate
    Next
    Wend
    'Autofit the cells
    xlSheet.Columns("A:L").Select
    'xlSheet.Range("G4524").Activate
    xlSheet.Columns("A:L").EntireColumn.AutoFit
    'Populate the designation field/column populates with the level 0 part description for piece parts
    ' xlSheet.Range("E2").Select
    ' xlSheet.Range("E2").FormulaR1C1 = "=IF(RC[-8]=1,RC[-4],R[-1]C)"
    ' xlSheet.Selection.AutoFill Destination:=xlSheet.Range("L3:L" & Lrow), Type:=xlFillDefault
    ' xlSheet.Range("A1").Select

    End With

    xlBook.Save
    xlBook.Close False
    xlApp.Quit
    xlApp.Quit
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    'Transfer data from selected worksheet to tblBOM
    DoCmd.TransferSpreadsheet acImport, , "tblBOM", strInputFileName, -1
    'SQL statement to update "vehicle" to name put in field on BOM upload form
    strSQL = "UPDATE tblBOM " _
    & "SET tblBOM.Vehicle = '" & [Forms]![frmBOMUpload]![txtOBV] & "'" _
    & "WHERE (((tblBOM.Vehicle)is null))OR (((tblBOM.Vehicle)=""""));"
    DoCmd.SetWarnings False
    'Run the update query to populate the vehicle "name" for the newly uploaded records
    DoCmd.RunSQL strSQL
    'turn off warnings (back on when done) and run the query that populates the "tblADPML_ManualData" table with new records needing completion.
    DoCmd.SetWarnings False
    'DoCmd.OpenQuery "qryUpdateCompTypeBOM"
    'insert query to update blank Rev to N/A
    ' DoCmd.OpenQuery "qryADPML_Manual"
    ' DoCmd.OpenQuery "qryADPML_Manual_Specific"
    ' DoCmd.OpenQuery "qryADPML_Common_Manual"
    'DoCmd.OpenForm "frmBOMEntry"
    DoCmd.SetWarnings True
    ' Clean up


    End Sub

  2. #2
    June7's Avatar
    June7 is online now VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    52,795
    Have you step debugged? Which line throws error?

    This code used to work for more than 13000 records? What has changed? Software or equipment upgrade?

    That error can mean a missing library reference.
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  3. #3
    SYFYLADY is offline Novice
    Windows 7 64bit Access 2007
    Join Date
    Mar 2014
    Location
    Arizona
    Posts
    3
    I have done the step through on smaller uploads and it works just fine. I uploaded the 13000 line record yesterday and it worked. Then I attempted the 16500 line file and it gave me nothing but errors. I tried to save it and recompile but still wuld not load.

    I keep thinking there is some limit to the amount of lines that can go in but I have not been able to figure out where that limit would be set.

  4. #4
    June7's Avatar
    June7 is online now VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    May 2011
    Location
    The Great Land
    Posts
    52,795
    I encountered a similar issue with code that saves reports as PDF. I had 65,000+ records to output and it failed if I attempted batches of more than about 5,000 at a time.

    I don't know of any such adjustment setting.

    I read a thread where poster imported 1 million records successfully but following attempt for 850,000 records failed. Suggestion was made to run Compact & Repair between imports.
    How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  5. #5
    SYFYLADY is offline Novice
    Windows 7 64bit Access 2007
    Join Date
    Mar 2014
    Location
    Arizona
    Posts
    3
    Thanks for the input. I went back into the excel sheet I had been using to test with and reloaded it. It worked once after that then died again. I thnk maybe it was a combination of a bad file and the things I had already fixed that were working against me. I am giving it one more try from the top.

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 3
    Last Post: 11-12-2013, 04:13 PM
  2. Replies: 1
    Last Post: 03-14-2013, 12:39 PM
  3. Replies: 1
    Last Post: 12-14-2012, 12:32 AM
  4. Replies: 4
    Last Post: 06-08-2012, 09:08 AM
  5. Application-defined or object-defined error
    By hawkins in forum Access
    Replies: 6
    Last Post: 07-01-2011, 01:57 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums