still having problems from autocad to excel.. i REAALLLY need some help

[btraemoore]

at this point I'm just trying to work in excel from autocad..

I'm getting "error '1004' application-defined or object-defined error"

here is all the code i have....

"EDIT: maybe im not giving enough information. What i'm trying to do is get a collection of text that matches a specific criteria, open an excel spreadsheet, look for each in the first colomn of the spreadsheet, if the value from the dwg match the value in the cell, copy the entire row to a different spread sheet. once they are all found or as many as possible save it. i will notate red in the code.

Global Dwg_Name As String, Cur_TxtSTR As String, EOC As Integer
Global text_coll As New Collection
'declaration of public variables
---------------------------------------------------------

Sub SS_delete(X As Byte)
    If ThisDrawing.SelectionSets.Count > 0 Then
    Dim i As Integer
        On Error Resume Next
        For i = 0 To ThisDrawing.SelectionSets.Count - 1
            ThisDrawing.SelectionSets.Item(i).Delete
        Next i
        On Error GoTo 0
    End If
End Sub
-----------------------------------------------------------------

Sub GetText()
    Dim gpCode(1) As Integer
    Dim dataValue(1) As Variant
    Dim SS_text As AcadSelectionSet
    Dim i As Integer
        Dwg_Name = ActiveDocument.Name
    Dim Ncnt As Integer
        Ncnt = Len(Dwg_Name)
        
    Select Case Ncnt
        Case 17
            Dwg_Name = Mid(Dwg_Name, 1, 13)
        Case 18
            Dwg_Name = Mid(Dwg_Name, 1, 14)
        Case 19
            Dwg_Name = Mid(Dwg_Name, 1, 15)
        Case 20
            Dwg_Name = Mid(Dwg_Name, 1, 16)
    End Select
    
    SS_delete 1
    
    Set SS_text = ThisDrawing.SelectionSets.Add("SS_text")'------get a ss of text
        gpCode(0) = 0: dataValue(0) = "*text"
        gpCode(1) = 8: dataValue(1) = "text"
        
    SS_text.Select acSelectionSetAll, , , gpCode, dataValue
    
    Dim cur_txtObj As AcadText
    Dim Ccnt As Integer, C As Integer
    Dim Ent As AcadEntity
       
    For Each Ent In SS_text'------modify the text entities that i need
        If UCase(Ent.ObjectName) = UCase("ACDBTEXT") _
        Or UCase(Ent.ObjectName) = UCase("ACDBMTEXT") Then
            Set cur_txtObj = Ent
                Cur_TxtSTR = cur_txtObj.TextString
                Ccnt = Len(Cur_TxtSTR)
            If Ccnt <= 6 And Mid(Cur_TxtSTR, 4, 1) = "-" Then
                Cur_TxtSTR = "CCU3-" & Cur_TxtSTR
                 text_coll.Add Cur_TxtSTR
            End If
            
        End If
    
    Next Ent
    EOC = text_coll.Count
    C = 1
    For i = 1 To EOC'----- remove doubles from collection if there are any
        If C > EOC Then Exit For
        Cur_TxtSTR = text_coll(i)
            For n = 2 To EOC
            If Cur_TxtSTR = text_coll(n) And n <> C Then
                text_coll.Remove (n)
                EOC = text_coll.Count
                Exit For
            End If
        Next n
        C = C + 1
    Next i
    RetrieveEXC
    ExcelWork
End Sub
-------------------------------------------------------------
module 2

' Declare Working Directory
    Global Const WrkDir = "C:\Documents and Settings\moorerb\Desktop\asset worksheets\"
' Declare Excel Workbook name
    Global Const Master_WorkBook = WrkDir & "bptags.xls"
    Global Const Secondary_WorkBook = WrkDir & "mytemp.xls"
' Declare Excel Worksheet name
    Global Const Master_WorkSheet = "ccu3"
    Global Const Secondary_WorkSheet = "template"
    Global Const Tertiary_worksheet = "sheet1"
    
    
Global test As Object
Global workbooks As Object
Global ExcelVer As Integer
Global ExcelServer As Object
Global MasWorksheet As Object
Global secWorksheet As Object
Global ObjWorkbook As Object
Global FileSaveName As String
' end of global variables
--------------------------------------------------------------------

Sub RetrieveEXC()'------open excel
    Set ExcelServer = CreateObject("Excel.Application.11")
        Set workbooks = ExcelServer.workbooks
        workbooks.Add ("C:\Documents and Settings\moorerb\Desktop\asset worksheets\mytemp.xls")
        workbooks.Open (Master_WorkBook)
    Set secWorksheet = ExcelServer.ActiveWorkbook.worksheets(Secondary_WorkSheet)
    Set MasWorksheet = ExcelServer.ActiveWorkbook.worksheets(Master_WorkSheet)
    
        'ExcelServer.WindowState = -4140
        ExcelServer.Visible = True
        FileSaveName = WrkDir & Dwg_Name & ".xls"
End Sub
-----------------------------------------------------------------------

Sub ExcelWork()
    Dim info As Boolean
    Dim RowLocation As Long
    Dim CSearch As Object
    'Dim C_range As Range
         'C_range = (A1)
    info = False
    Dim Ent As AcadEntity
    Dim i As Integer

    MasWorksheet.Activate'---activate the master worksheet
    
    For i = 1 To EOC
    
    Cur_TxtSTR = text_coll(i)
    MasWorksheet.Range(A, 1).Activate
from the light blue down to light blue is where my biggest issue is.
    MasWorksheet.Range(Selection, Selection.End(xlDown)).Select
        If Cur_TxtSTR = xlValue Then
            MasWorksheet.RowLocation = ActiveCell.row
            MasWorksheet.Rows(RowLocation).Select
            Selection.Copy
            Selection.ClearContents
            secWorksheet.Activate
            ActiveSheet.Paste
            secWorksheet.Range.Next.row
        Else
            MasWorksheet.Range.Next.row
        End If
    
    Next i

End Sub

        
   





Sub set_to_nil()
    Set ExcelServer = Nothing
    Set ObjWorksheet = Nothing
    'set SecWorksheet = nothing
    Set ObjWorkbook = Nothing
    
End Sub

Public Sub save_file()
ActiveWorkbook.SaveAs FileName:= _
        FileSaveName, fileformat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
End Sub

[fixo]

Try to change this code block

 
    Dim oText As AcadText
    Dim oMText As AcadMText
    Dim Ccnt As Integer, C As Integer
    Dim Ent As AcadEntity
 
    For Each Ent In SS_text
              If TypeOf Ent Is AcadText Then
              Set oText = Ent
                    Cur_TxtSTR = oText.TextString
                Ccnt = Len(Cur_TxtSTR)
            If Ccnt <= 6 And Mid(Cur_TxtSTR, 4, 1) = "-" Then
                Cur_TxtSTR = "CCU3-" & Cur_TxtSTR
                 text_coll.Add Cur_TxtSTR
            End If
            End If
        If TypeOf Ent Is AcadMText Then
              Set oMText = Ent
 
                Cur_TxtSTR = oMText.TextString
                Ccnt = Len(Cur_TxtSTR)
            If Ccnt <= 6 And Mid(Cur_TxtSTR, 4, 1) = "-" Then
                Cur_TxtSTR = "CCU3-" & Cur_TxtSTR
                 text_coll.Add Cur_TxtSTR
            End If
 
        End If
 
    Next Ent

Again, in this line:
MasWorksheet.Range(A, 1).Activate
variable A is not defined


~'J'~

[btraemoore]

thank you very much!!! such a small mistake... i found it yesterday about an hour after i put the code back up, here is what i changed it to.

Sub ExcelWork()
    Dim info As Boolean
    Dim RowLocation As Long
    Dim CSearch As Object
    'Dim C_range As Range
         'C_range = (A1)
    info = False
    Dim Ent As AcadEntity
    Dim i As Integer, n As Long
    Dim CurrentItem As String
    Dim pause As Boolean
    Dim match As Object
    MasWorksheet.Activate
    
    MasWorksheet.cells(1, 1).Activate
    'MasWorksheet.Activate.EntireColumn.autofit
    
    For i = 1 To EOC
    Cur_TxtSTR = text_coll(i)
        For n = 1 To 876
        CurrentItem = MasWorksheet.cells(n, 1).Value
            If Cur_TxtSTR = CurrentItem Then
                pause = True
                MasWorksheet.Rows(n).Select
                Set match = MasWorksheet.Rows(n)
                MasWorksheet.Rows(n).ClearContents
                secWorksheet.Activate
                secWorksheet.insert (match)
                'secWorksheet.Range.Next.row still having issues with this, but researching right now.
            End If
    
        Next n
        
    Next i

End Sub

Thanks again for your insight

[btraemoore]

OK!!! so i completed the routine and wanted to post it for others to learn from...
it is in working order...
this is only my 4th vba routine, enjoy

Global Dwg_Name As String, Cur_TxtSTR As String, EOC As Integer
Global text_coll As New Collection
'declaration of public variables

'
' Delete all existing Selection sets
'

Sub SS_delete(X As Byte)
    If ThisDrawing.SelectionSets.Count > 0 Then
    Dim i As Integer
        On Error Resume Next
        For i = 0 To ThisDrawing.SelectionSets.Count - 1
            ThisDrawing.SelectionSets.Item(i).Delete
        Next i
        On Error GoTo 0
    End If
End Sub

'
' Work done in autoCAD
'

Sub gettext()
    Dim gpCode(1) As Integer
    Dim dataValue(1) As Variant
    Dim SS_text As AcadSelectionSet
    Dim i As Integer
        Dwg_Name = ActiveDocument.Name ' get the drawing name
    Dim Ncnt As Integer
        Ncnt = Len(Dwg_Name)
        
    
    Select Case Ncnt ' remove .dwg from the name
        Case 17
            Dwg_Name = Mid(Dwg_Name, 1, 13)
        Case 18
            Dwg_Name = Mid(Dwg_Name, 1, 14)
        Case 19
            Dwg_Name = Mid(Dwg_Name, 1, 15)
        Case 20
            Dwg_Name = Mid(Dwg_Name, 1, 16)
    End Select
    
    SS_delete 1
    
    Set SS_text = ThisDrawing.SelectionSets.Add("SS_text") ' define our selection set
        gpCode(0) = 0: dataValue(0) = "*text"
        gpCode(1) = 8: dataValue(1) = "text"
        
    SS_text.Select acSelectionSetAll, , , gpCode, dataValue
    
    Dim cur_txtObj As AcadText
    Dim Ccnt As Integer, c As Integer
    Dim Ent As AcadEntity
       
    ' filter through all text
    For Each Ent In SS_text
        If UCase(Ent.ObjectName) = UCase("ACDBTEXT") _
        Or UCase(Ent.ObjectName) = UCase("ACDBMTEXT") Then
            Set cur_txtObj = Ent
                Cur_TxtSTR = cur_txtObj.TextString            'set variable to the contents of the text
                Ccnt = Len(Cur_TxtSTR)                        'get the length of the text string
            
            If Ccnt <= 8 And Mid(Cur_TxtSTR, 4, 1) = "-" Then 'looking for text with the 4th chr "-"
                Cur_TxtSTR = "CCU3-" & Cur_TxtSTR             'add "ccu3-" to the front of all applicable text
                text_coll.Add Cur_TxtSTR                      'add text to a collection
            End If
            
        End If
    
    Next Ent
    
    'compare all elements in collection to one another
    'to make sure we dont have any doubles
    EOC = text_coll.Count
    c = 1 ' set a count to make sure we don't delete the item we're reading from
    For i = 1 To EOC ' i = the item number in collection are are using to compare, EOC = end of collection
        If c > EOC Then Exit For ' error handling
        Cur_TxtSTR = text_coll(i)
        For n = 2 To EOC ' n = item number in collection we are comparing to
            If Cur_TxtSTR = text_coll(n) And n <> c Then ' if they match and is not the same item
                text_coll.Remove (n) ' remove it from the collection
                EOC = text_coll.Count ' get a new count of items in collection
                Exit For
            End If
        Next n
        c = c + 1 ' add 1 to our "c" count since we are moving up 1 in our "i" count
    Next i
    
    'move to the work done in excel
    RetrieveEXC
    excelwork
End Sub


Sub MakeAssetSheet()
   gettext
End Sub

' Declare Working Directory
    Global Const WrkDir = "C:\Documents and Settings\moorerb\my documents\asset worksheets\"
' Declare Excel Workbook name
    Global Const Master_WorkBook = WrkDir & "bptags.xls"
' Declare Excel Worksheet name
    Global Const Master_WorkSheet = "ccu3"
    Global Const Secondary_WorkSheet = "template"

Global workbooks As Object
Global ExcelVer As Integer
Global ExcelServer As Object
Global MasWorksheet As Object
Global secWorksheet As Object
Global ObjWorkbook As Object
Global FileSaveName As String
' end of global variables

'
' open excel
'

Sub RetrieveEXC()
    Set ExcelServer = CreateObject("Excel.Application.11")
    Set workbooks = ExcelServer.workbooks
        workbooks.Open (Master_WorkBook)
    Set secWorksheet = ExcelServer.activeworkbook.worksheets(Secondary_WorkSheet)
    Set MasWorksheet = ExcelServer.activeworkbook.worksheets(Master_WorkSheet)
    
        'set the window to invisable
        ExcelServer.WindowState = -4140
        ExcelServer.Visible = False
End Sub

'
' work done in excel
'

Sub excelwork()
    Dim i As Integer, n As Long, c As Long
        c = 8
    Dim CurrentItem As String
    Dim pause As Boolean
    Dim match As Variant
    Dim NewSheetName As String
        NewSheetName = Dwg_Name & "assets"
        
    'set a count for items in collection
    For i = 1 To EOC
    Cur_TxtSTR = text_coll(i)
    MasWorksheet.Activate
    MasWorksheet.cells(1, 3).Activate
    
        'set a count for items in excel spreadsheet
        For n = 1 To 876
        CurrentItem = MasWorksheet.cells(n, 3).Value
            
            'compare collection item to each excel item, until we find our match
            If Cur_TxtSTR = CurrentItem Then
                MasWorksheet.Rows(n).Select                ' select the row
                MasWorksheet.Rows(n).Copy                  ' copy the row
                secWorksheet.Activate
                secWorksheet.cells(c, 1).Activate
                secWorksheet.paste                               ' paste the row in the new sheet
                secWorksheet.cells(c, 10).Value = Dwg_Name ' insert the drawing name in new sheet
                c = c + 1
            End If
    
        Next n
        
    Next i
    
    secWorksheet.Copy ' copy the new sheet
    ExcelServer.activeworkbook.sheets("template").Name = NewSheetName ' set the new sheet name
    FileSaveName = ExcelServer.Application.GetSaveAsFilename _
    (InitialFileName:=Dwg_Name & ".xls", Title:="Save As")            ' choose where we're going to save it
    
    If FileSaveName = "False" Then                         ' error handleing
        MsgBox "File not Saved, Actions Cancelled."
        Exit Sub
    Else
        ExcelServer.activeworkbook.SaveAs FileSaveName ' save it
        ExcelServer.activeworkbook.Close               ' close it
    End If
    
    ExcelServer.Application.DisplayAlerts = False ' hide unwanted alerts
    ExcelServer.workbooks("bptags.xls").Close     ' close the work book
    ExcelServer.Quit                              ' quit excel
    set_to_nil                                    ' function to reset object variables to nothing
    
End Sub


Sub set_to_nil()
    Set workbooks = Nothing
    Set ExcelServer = Nothing
    Set MasWorksheet = Nothing
    Set secWorksheet = Nothing
    Set ObjWorkbook = Nothing
End Sub