Invalid template error

Invalid template error

Anonymous
Not applicable
1,332 Views
12 Replies
Message 1 of 13

Invalid template error

Anonymous
Not applicable

Hi, all!  I've got a macro which queries a folder full of Inventor .dwg files, opens each and does several rare and wonderful things.  Everything generally works fine, except every once in a while, we use AutoCAD to make a "Paint and Stencil Instructions" drawing, AutoCAD being WAAAYYY easier to do this with than Inventor.  The problem is, when the macro tries to open this drawing, I get an error "A valid Inventor template is required..."  I need a way to either trap this error and skip that drawing, or query the drawing somehow before Inventor tries to open it.  We use ".dwg" Inventor templates, so I can't look for the file extension.  I've got the macro rigged for "SilentOperation", so there's no error shown, it runs the ErrorHandler and terminates the program.  It iterates thru the drawings using a "For... Next" statement, so if I could use an ErrorHandler that just stated "Next", that would do it, but I don't know if I can code that. Here is a snip of the code in the macro showing the call to the sub that does the work.  Does anyone have a suggestion?  Thanx.



Global objFiles As Object Global thing As Variant Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Set objFiles = fso.GetFolder(strFolderName).Files 'FROM FILE DIALOG For Each thing In objFiles Call SetVarsNull If Right((thing.Name), 3) = "dwg" Then '------------------------------------------------------------------ 'FOR EACH INVENTOR FILES IN FOLDER; CALLS THE SUB TO OPEN 'THE DRAWING Call GetDwgOpen(thing, NumOfDwgs, strFolderName, ShtSz, filepath) 'HERE IS WHERE I NEED TO TRAP THE ERROR Call CloseDwg(thing) End If Next
0 Likes
Accepted solutions (2)
1,333 Views
12 Replies
Replies (12)
Message 2 of 13

Owner2229
Advisor
Advisor
Accepted solution

Hi, first you should use Document instead of Variant.

Global thing As Document

Second, you can use this to pass the error:

On Error Resume Next

Place it at the start of the Sub. You have to put it every sub that uses your "thing" variable, so the sub where you're calling the for loop and both the "GetDwgOpen" and "CloseDwg".

 

When an error occures it will ignore it and go to next operation.

 

Btw. Wouldn't it be better to open and close the DWG all in one Sub instead of jumping back and forth between them?

Consider using "Accept as Solution" / "Kudos" if you find this helpful.
- - - - - - - - - - - - - - -
Regards,
Mike

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live." - John F. Woods
Message 3 of 13

Anonymous
Not applicable

Owner;

That did the trick, thank you!  I had tried something like that, but I used "On Error Goto Next" which bombed.  You're right about the call to "CloseDwg", this macro needs a complete restructuring!  I never had formal training in programming, I learned by doing, so proper code flow suffers greatly in my macros... which begs the question, does a programmer who is self-taught have a fool for a teacher or a fool for a student? Smiley Happy  Thanx again for the help!!

0 Likes
Message 4 of 13

Owner2229
Advisor
Advisor

Well, I've started with iLogic about 2 years ago and on the go I have learned a lot about programming and Inventor.

You just need the passion, patience and time 😄

 

You can post your whole code here or in new thread and I'll look at it.

Consider using "Accept as Solution" / "Kudos" if you find this helpful.
- - - - - - - - - - - - - - -
Regards,
Mike

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live." - John F. Woods
0 Likes
Message 5 of 13

Anonymous
Not applicable

Mike;

Here is the code.  A couple things, we are working in Inventor 2011, and the spreadsheet the code creates is in OpenOffice.  Also, we are using Windows XP (yes, it still runs!!) if that matters.  The program is long, and meanders quite a bit Smiley Embarassed but it produces the result.  I have to maintain it sometimes, and it can turn ME into that "violent psychopath" you speak of! Smiley Very Happy

.

Option Explicit
'this program gets property info from drawing and model
'and sticks it into flatBOM in OpenOfficeCalc
Global odoc As DrawingDocument
'Global oPtDoc As Document
Global oSheet As Sheet
Global oSheets As Sheets
'Global partnumext As String
Global partnumtype As String 'DRAWING TYPE (A, Q, M, OR other)
'Global FullFileName As String
Global strFileName As String
Global strFileName2 As String
Global clickedFileName As String
Global clickedFileName2 As String
Global go As Boolean
Global projnum As String
Global NumOfDwgs As Integer
Global strFolderName As String 'THIS IS THE NAME OF THE FOLDER, TAKEN FROM "oFileDlg.Filename"

Global objFiles As Object
Global filecount As Integer 'NUMBER OF INVENTOR FILES IN FOLDER

Global oServiceManager As Object

Global oDesktop As Object
Global oCalcDoc As Object
Global oCalcSheet As Object

Global objfileDwg As FileDialogForDrawing
Global objfileBOM As FileDialogForFlatBOM
Global oTitlBlkDef As TitleBlockDefinition
Global oTitlBlk As TitleBlock
Global oBrdr As Border
Global Titl As String
Global ShtSz As String 'SHEET SIZE, VARIABLE FILLED IN "Sub GetTitleBlockStuff"
Global Rvz As String
'thing is set the file in folder
Global thing As Variant 'INVENTOR FILES IN FOLDER
'Global thing As Document 'SUPPOSEDLY THIS WILL WORK BETTER
Global DwgNo As String 'THE STARFIRE "DRAWING NUMBER" (15020-A001.dwg)
Global ComponentNo As String
Global ComponentDesc As String
Global fltBOMLine As Integer
Global specListLine As Integer
Global MtlSpec As String
Global MtlType As String
Global QtyCar As String
Global NxtAsy As String
Global filepath As String
Global SpecPrtDesc As String
Global SpecPrtNo As Variant
Global SpecQtyCar As String
Global AsyPerCar As Integer

Public Sub fillFlatBOM()
'DOCUMENTED AND COMMENTED 02OCT13
'goes to END if no flatBOM or no dwgs

'------------------------------------------------------------------
'CALLS THE FILE DIALOG OPEN FOR THE OpenOffice SPREADSHEET.  OPENS A FILE DIALOG TO SURF TO AND
'SELECT THE flatBOM SPREADSHEET; THEN STORES THE PATH TO THE SPREADSHEET IN A VARIABLE... 02Mar16
'------------------------------------------------------------------
Call FileDialogForSpreadsheet

'------------------------------------------------------------------
'NOT SURE I NEED THIS... 02Mar16
'------------------------------------------------------------------
On Error GoTo ErrorHandler

'initializes Used Rows to 0
'------------------------------------------------------------------
'OpenOffice Calc DOESN'T HAVE A "USED rANGE" FUNCTION SO THIS IS NEEDED TO INITIALIZE THE "ACTIVE ROW"
'TO "0" FOR THE "USED ROWS" CODE... 02Mar16
'------------------------------------------------------------------
fltBOMLine = 0
specListLine = 0

'------------------------------------------------------------------
'CALLS THE CODE TO OPEN OpenOffice Calc.  "URLEncode(strFileName2)" TAKES THE PATH STRING RETURNED
'FROM THE FILE DIALOG AND FORMATS THE PATH STRING INTO THE WONKY FORMAT OpenOffice USES FOR ITS URL;
'"oDesktop.loadComponentFromURL" LOADS (?OPENS?) SPREADSHEET USING THE REFORMATTED PATH;
'"GetUsdRngfltBOM(fltBOMLine)" ITERATES THROUGH THE "BOM" WORKSHEET AND COUNTS THE USED ROWS, THIS
'ALLOWS ADDING NEW ROWS ONTO AN EXISTING SPREADSHEET; "GetUsdRngSpec(specListLine)" ITERATES THROUGH
' THE "SPECIALTY" WORKSHEET 7 DOES SAME... 02Mar16
'------------------------------------------------------------------
Call OpenCalc
'return from OpenCalc()
''''''Call GetNumOfDwgs
Call FileDialogForDrawings
'return from GetNumOfDwgs()
Call OpenDwgs

MsgBox "Done!"

On Error GoTo ErrorHandler
Exit Sub
ErrorHandler:
MsgBox "An Error Has Occurred; The Program Will Terminate. Drawing" & thing, vbInformation
End
End Sub
Private Sub FileDialogForSpreadsheet()
strFileName2 = ""
    ' Create a new FileDialog object.

    Dim oFileDlg As FileDialog
    Call ThisApplication.CreateFileDialog(oFileDlg)

    oFileDlg.Filename = ""

    ' Define the filter to select part and assembly files or any file.
    oFileDlg.Filter = "OpenOffice Files (*.ods)|*.ods|All Files (*.*)|*.*"

    ' Define the part and assembly files filter to be the default filter.
    oFileDlg.FilterIndex = 1

    ' Set the title for the dialog.
    oFileDlg.DialogTitle = "Find a flatBOM Spreadsheet"

    ' Set the initial directory that will be displayed in the dialog.
    oFileDlg.InitialDirectory = "Y:\LIB_NVTR\VBA\Files for OpenOffice flatBOM Test 02Mar16"

    ' Set the flag so an error will be raised if the user clicks the Cancel button.
    oFileDlg.CancelError = True

    ' Show the open dialog.  The same procedure is also used for the Save dialog.
    ' The commented code can be used for the Save dialog.
    On Error Resume Next
    oFileDlg.ShowOpen
'    oFileDlg.ShowSave

    ' If an error was raised, the user clicked cancel, otherwise display the filename.
    If Err Then
        MsgBox "User cancelled out of dialog"
        Else
            If oFileDlg.Filename = "" Then
        MsgBox "File " & oFileDlg.Filename & " was selected."
        End If
    End If
    strFileName2 = oFileDlg.Filename
    
'End
    
End Sub
Private Sub SetVarsNull()
'DOCUMENTED AND COMMENTED 23SEP13
'called from OpenDwgs()
'sets to null or "0" all variables which go into spreadsheet
projnum = ""
ShtSz = ""
Rvz = ""
DwgNo = ""
'partnumext = ""
partnumtype = ""
matlType = ""
nextassy = ""
partQty = ""
dashTwo = False
ComponentNo = ""
ComponentDesc = ""
MtlSpec = ""
MtlType = ""
QtyCar = ""
NxtAsy = ""
SpecPrtDesc = ""
SpecPrtNo = 0
SpecQtyCar = ""
AsyPerCar = 0
filepath = ""
End Sub
Private Sub OpenCalc()
'------------------------------------------------------------------
'CALLS THE CODE TO OPEN OpenOffice Calc.  "URLEncode(strFileName2)" TAKES THE PATH STRING RETURNED
'FROM THE FILE DIALOG AND FORMATS THE PATH STRING INTO THE WONKY FORMAT OpenOffice USES FOR ITS URL;
'"oDesktop.loadComponentFromURL" LOADS (?OPENS?) SPREADSHEET USING THE REFORMATTED PATH;
'"GetUsdRngfltBOM(fltBOMLine)" ITERATES THROUGH THE "BOM" WORKSHEET AND COUNTS THE USED ROWS, THIS
'ALLOWS ADDING NEW ROWS ONTO AN EXISTING SPREADSHEET; "GetUsdRngSpec(specListLine)" ITERATES THROUGH
' THE "SPECIALTY" WORKSHEET 7 DOES SAME... 02Mar16
'------------------------------------------------------------------

On Error GoTo ErrorHandler
'DOCUMENTED AND COMMENTED 18SEP13
'called from initial public sub fillFlatBOM()
Dim chtr As String
Dim numbrbkslh As Integer
Dim plength As Integer
Dim pickedFileName As String
Dim objFile As FileDialogForFlatBOM
Dim strFilter As String
go = False
    'sets OpenOffice objects
    Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
    Set oDesktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")
    Dim aNoArgs()
'------------------------------------------------------------------
'reformats file name of flatbom so OpenOffice StarBasic can read it
'Y:\LIB_NVTR\VBA\Excel_flatBOM_4_Test\OpenOfficeCalc_flatBOM_4_Test\OpenOffice_BOM.ods
'BECOMES
'file:///Y:/LIB_NVTR/VBA/Excel_flatBOM_4_Test/OpenOfficeCalc_flatBOM_4_Test/OpenOffice_BOM.ods
'02Mar16
'------------------------------------------------------------------
    Call URLEncode(strFileName2)
'------------------------------------------------------------------
'returnS from URLEncode(strFileName2)
'opens flatBOM.ods... 02Mar16
'------------------------------------------------------------------
    Set oCalcDoc = oDesktop.loadComponentFromURL(strFileName2, "_blank", 0, aNoArgs())
'------------------------------------------------------------------
'activates sheet named "BOM"... 02Mar16
'------------------------------------------------------------------
    Set oCalcSheet = oCalcDoc.getSheets().GetByName("BOM")
    Call GetUsdRngfltBOM(fltBOMLine)
'------------------------------------------------------------------
'returns from GetUsdRngfltBOM(fltBOMLine)... 02Mar16
'------------------------------------------------------------------
    Set oCalcSheet = oCalcDoc.getSheets().GetByName("SPECIALTY")
    Call GetUsdRngSpec(specListLine)
'------------------------------------------------------------------
'returns from GetUsdRngSpec(specListLine)
'return to initial public sub fillFlatBOM()... 02Mar16
'------------------------------------------------------------------

Exit Sub
ErrorHandler:
MsgBox "An Error Has Occurred; The Program Will Terminate."
    End
End Sub
Public Function URLEncode(strFileName2)
'------------------------------------------------------------------
'DOCUMENTED AND COMMENTED 18SEP13
'called from inside of OpenCalc()
    'reformats file name of flatbom so OpenOffice StarBasic can read it
    'Y:\LIB_NVTR\VBA\Excel_flatBOM_4_Test\OpenOfficeCalc_flatBOM_4_Test\OpenOffice_BOM.ods
    'BECOMES
    'file:///Y:/LIB_NVTR/VBA/Excel_flatBOM_4_Test/OpenOfficeCalc_flatBOM_4_Test/OpenOffice_BOM.ods
'------------------------------------------------------------------

'PROLLY OUGHTA COMMENT THIS BETTER, THO IT SEEMS SELF-EXPLANATORY... 02Mar16

Dim SpaceAsPlus As Boolean
SpaceAsPlus = False
Dim StringLen As Long: StringLen = Len(strFileName2)
  If StringLen > 0 Then
    ReDim result(StringLen) As String
    Dim i As Long, CharCode As Integer
    Dim Char As String, Space As String
    If SpaceAsPlus Then Space = "+" Else Space = "%20"
    For i = 1 To StringLen
      Char = Mid$(strFileName2, i, 1)
      CharCode = Asc(Char)
      Select Case CharCode
        Case 92
          result(i) = chr(47)
        Case 0 To 15
          result(i) = chr(CharCode)
        Case Else
          result(i) = chr(CharCode)
      End Select
    Next i
    strFileName2 = Join(result, "")
    strFileName2 = "file:///" & strFileName2
  End If
'------------------------------------------------------------------
  'returns to OpenCalc()
'------------------------------------------------------------------

End Function
Private Sub GetUsdRngfltBOM(fltBOMLine)
'------------------------------------------------------------------
'DOCUMENTED AND COMMENTED 23SEP13
'called from inside of OpenCalc()
'reads data in .ods file worksheet "BOM" line-by-line to find the last line of data (UsedRange)
'DO NOT LEAVE ANY BLANK LINES IN THE SPREADSHEET!!!!
'IF THERE ARE ANY BLANK LINES IN THE SPREADSHEET, THE PROGRAM WILL OVERWRITE ANY DATA AFTER
'THE BLANK LINE!!!!
'------------------------------------------------------------------

    Dim Cellval As Variant
    Dim LFcell1 As Object
    Set LFcell1 = oCalcSheet.getCellByPosition(0, fltBOMLine)
    Cellval = LFcell1.String
    Do Until Cellval = ""
        If Cellval <> "" Then
            fltBOMLine = fltBOMLine + 1
            Set LFcell1 = oCalcSheet.getCellByPosition(0, fltBOMLine)
            Cellval = LFcell1.String
        End If
    Loop
'------------------------------------------------------------------
    'returns to OpenCalc()
'------------------------------------------------------------------

End Sub
Private Sub GetUsdRngSpec(specListLine)
'------------------------------------------------------------------
'DOCUMENTED AND COMMENTED 23SEP13
'called from inside of OpenCalc()
'reads data in .ods file worksheet "BOM" line-by-line to find the last line of data (UsedRange)
'DO NOT LEAVE ANY BLANK LINES IN THE SPREADSHEET!!!!
'IF THERE ARE ANY BLANK LINES IN THE SPREADSHEET, THE PROGRAM WILL OVERWRITE ANY DATA AFTER
'THE BLANK LINE!!!!
'------------------------------------------------------------------

    Dim Cellval As Variant
    Dim LFcell1 As Object
    Set LFcell1 = oCalcSheet.getCellByPosition(3, specListLine)
    Cellval = LFcell1.String
    Do Until Cellval = ""
        If Cellval <> "" Then
            specListLine = specListLine + 1
            Set LFcell1 = oCalcSheet.getCellByPosition(3, specListLine)
            Cellval = LFcell1.String
        End If
    Loop
'------------------------------------------------------------------
    'returns to OpenCalc()
'------------------------------------------------------------------

End Sub
Private Sub FileDialogForDrawings()
filecount = 0
strFolderName = ""
    ' Create a new FileDialog object.

    Dim oFileDlg As FileDialog
    
    Call ThisApplication.CreateFileDialog(oFileDlg)
    oFileDlg.Filename = ""

    ' Define the filter to select part and assembly files or any file.
    oFileDlg.Filter = "Inventor Files (*.dwg)|*.dwg|All Files (*.*)|*.*"

    ' Define the part and assembly files filter to be the default filter.
    oFileDlg.FilterIndex = 1

    ' Set the title for the dialog.
    oFileDlg.DialogTitle = "Find a Drawing"

    ' Set the initial directory that will be displayed in the dialog.
    oFileDlg.InitialDirectory = "Y:\LIB_NVTR\VBA\Files for OpenOffice flatBOM Test 02Mar16"

    ' Set the flag so an error will be raised if the user clicks the Cancel button.
    oFileDlg.CancelError = True

    ' Show the open dialog.  The same procedure is also used for the Save dialog.
    ' The commented code can be used for the Save dialog.
    On Error Resume Next
    oFileDlg.ShowOpen
'    oFileDlg.ShowSave

    ' If an error was raised, the user clicked cancel, otherwise display the filename.
    If Err Then
        MsgBox "User cancelled out of dialog"
        Else
            If oFileDlg.Filename = "" Then
        MsgBox "File " & oFileDlg.Filename & " was selected."
        End If
    End If
    strFolderName = oFileDlg.Filename
        strFolderName = Left$(strFolderName, InStrRev(strFolderName, "\") - 1)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFiles = fso.GetFolder(strFolderName).Files
    
filecount = objFiles.Count

End Sub
Private Sub OpenDwgs()
On Error Resume Next

'DOCUMENTED AND COMMENTED 23SEP13
'called from initial public sub fillFlatBOM()
'opens each drawing
        'counts files in folder
'------------------------------------------------------------------
'NUMBER OF INVENTOR FILES IN FOLDER... 03Mar16
'------------------------------------------------------------------
        filecount = objFiles.Count
'------------------------------------------------------------------
'ITERATES THROUGH THE INVENTOR FILES IN FOLDER, SETS EACH AS "thing" AND FOR EACH:... 03Mar16
'------------------------------------------------------------------
        For Each thing In objFiles
        'iterates through filenames and
'------------------------------------------------------------------
'FOR EACH INVENTOR FILES IN FOLDER; SETS ALL VARIABLES TO NULL, "", OR 0... 03Mar16
'------------------------------------------------------------------
        Call SetVarsNull
        'if file is ".dwg"
'------------------------------------------------------------------
'FOR EACH INVENTOR FILES IN FOLDER; CHECKS TO SEE IF FILE IS A ".dwg"... 03Mar16
'------------------------------------------------------------------
            If Right((thing.Name), 3) = "dwg" Then
                'calls "GetDwgOpen
                'MsgBox thing
'------------------------------------------------------------------
'FOR EACH INVENTOR FILES IN FOLDER; CALLS THE SUB TO OPEN THE DRAWING
'SENDS VARIABLE "thing" (THIS IS THE DRAWING FILE); "strFolderName" (THIS IS THE NAME OF THE
'FOLDER, TAKEN FROM "oFileDlg.Filename", FILLED IN "Sub FileDialogForDrawings", WITH THE FILE
'NAME AND THE LAST BACKSLASH STRIPPED OFF; ShtSz (SHEET SIZE, VARIABLE FILLED IN
'"Sub GetTitleBlockStuff"); filepath (THIS IS FULL FILE PATH OF THE DRAWING FILE, "odoc.FullFileName",
'FILLED IN "Sub GetDwgOpen")... 03Mar16
'------------------------------------------------------------------
                Call GetDwgOpen(thing, NumOfDwgs, strFolderName, ShtSz, filepath)
'               returns through Call GetSpecialtyItems(SpecPrtDesc, SpecPrtNo, SpecQtyCar);
'               through Call GetTitleBlockStuff(Titl, ShtSz, DwgNo, Rvz, ComponentNo, MtlSpec, MtlType, QtyCar, NxtAsy);
'               through Call WriteSpecList(fltBOMLine, specListLine, Titl, ShtSz, DwgNo, Rvz, ComponentNo, MtlSpec, MtlType, QtyCar, NxtAsy, SpecPrtDesc, SpecPrtNo, SpecQtyCar)
'------------------------------------------------------------------
'TURNS ON ".SilentOperation", CLOSES DRAWING (WITHOUT SAVE), TURNS OFF ".SilentOperation"... 03Mar16
'------------------------------------------------------------------
                Call CloseDwg(thing)
            End If
        Next
        
        
        
End Sub

Private Sub GetDwgOpen(thing, NumOfDwgs, strFolderName, oSheetSize, filepath)
'DOCUMENTED AND COMMENTED 02OCT13
'called from OpenDwgs()
' I DON'T NEED TO CALL ANYTHING THAT'S NOT ON THE DRAWING...
'THIS IS GONNA BE HELL TO DOCUMENT....
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim m As Long
Dim oPartLists As PartsLists
Dim partlistrowcount As Integer
Dim partlistcolumncount As Integer
Dim RowArray As String
Dim oPartsList As PartsList
Dim oRow As PartsListRow
Dim oColumn As PartsListColumn
Dim SheetNum As Integer
'turns off error messages ("update required", etc.) on open .dwg
ThisApplication.SilentOperation = False
ThisApplication.SilentOperation = True
'opens first drawing in folder.  "thing" has been set to first file with ".dwg" extension
'NOTE; THESE ARE NOT IN THE ORDER THEY APPEAR IN THE FOLDER... THEY ARE IN SOME ARBITRARY ORDER
'DETERMINED BY WINDOWS
Set odoc = ThisApplication.Documents.Open(thing)
filepath = odoc.FullFileName
Set oSheets = odoc.Sheets


'activates sheet 1 OR first sheet that isn't "Model"
'*****************************************************************
'********PROBLEM SOLVING FOR "AutoCAD-BASED" DWG******************
'******DWG WITH ONE SHEET TITLED "Model(AutoCAD)"*****************
'*****************************************************************


'QUERIES DRAWING FOR SHEET NAMES AND ACTIVATES "Sheet:1"
Dim sheetone As Boolean
sheetone = False
SheetNum = 0
    Do Until SheetNum = odoc.Sheets.Count
        SheetNum = SheetNum + 1
    'MsgBox oSheets.Item(SheetNum).Name
        If oSheets.Item(SheetNum).Name = "Sheet:1" Then
            oSheets.Item(SheetNum).Activate
            sheetone = True
            'MsgBox oSheets.Item(SheetNum).Name
            SheetNum = odoc.Sheets.Count
            odoc.ActiveSheet.Update
            Else

            'oSheets.Item(1).Activate
        End If
    Loop
'ERROR TRAP FOR DWG WITH MIS-TITLED SHEET(S); THIS GIVES A MESSAGE BOX THAT ALERTS THE OPERATOR
'TO THE MIS-LABLED SHEET AND ASKS... SOMETHING....
    If sheetone = False Then
    MsgBox "No ""Sheet:1"" in this drawing!" & chr(13) & _
            "Note if the correct sheet is active and, if not, note the drawing number! "
    End If


Set oSheet = odoc.ActiveSheet

'not sure why this is here....
ThisApplication.SilentOperation = False
' find out if dwg is "A", "M", "Q", or other (part) drawing
Call GetPartNum(DwgNo, partnumtype)
Select Case Left(partnumtype, 1)
    Case "A"
        'if there are no parts lists in the dwg, skips this part
        'determines if there are parts lists
        If oSheet.PartsLists.Count > 0 Then
            'sets to parts lists item #1 (should be ASSEMBLY LIST)
            Set oPartsList = oSheet.PartsLists.Item(1)
            'determines if assembly list has rows
            If oPartsList.PartsListRows.Count > 0 Then
'                        'goes through each row and gets value in titled columns
'                        'IT DOESN'T DO ANYTHING WITH THE TITLES.... THERE'S NOTHING HAPPENING HERE....
                        Call GetSpecialtyItems(SpecPrtDesc, SpecPrtNo, SpecQtyCar)
            End If
        End If
        'and calls to fill title block info
        'CALLS TO FILL TITLE BLOCK WHETHER OR NOT THERE IS A PARTS LIST
        Call GetTitleBlockStuff(Titl, ShtSz, DwgNo, Rvz, ComponentNo, MtlSpec, MtlType, QtyCar, NxtAsy, filepath)
    Case "M"
        'if there are no parts lists in the dwg, skips this part
        'determines if there are parts lists
        If oSheet.PartsLists.Count > 0 Then
            'sets to parts lists item #1 (should be ASSEMBLY LIST)
            Set oPartsList = oSheet.PartsLists.Item(1)
            'determines if assembly list has rows
            If oPartsList.PartsListRows.Count > 0 Then
                        Call GetSpecialtyItems(SpecPrtDesc, SpecPrtNo, SpecQtyCar)
            End If
        End If
        'and calls to fill title block info
        'CALLS TO FILL TITLE BLOCK WHETHER OR NOT THERE IS A PARTS LIST
        Call GetTitleBlockStuff(Titl, ShtSz, DwgNo, Rvz, ComponentNo, MtlSpec, MtlType, QtyCar, NxtAsy, filepath)
    Case "Q"
    'THIS CASE IS ALL CODED FOR A STANDARD PARTS LIST... NEED TO CODE IT TO LOOK FOR THE PARTS
    'LIST TITLE FIELDS IN CASE WE USE A MULTI-QTY PARTS LIST
        'if there are no parts lists in the dwg, skips this part
        'determines if there are parts lists
        If oSheet.PartsLists.Count > 0 Then
            'gets a count of part lists
            For i = 1 To oSheet.PartsLists.Count
                Set oPartsList = oSheet.PartsLists.Item(i)
                'iterates through parts list until it finds the one for the Next Assembly
                If oPartsList.PartsListColumns.Item(4).Title = "NEXT ASSY./APPL." Then
                    j = oPartsList.PartsListRows.Count
                    For Each oRow In oPartsList.PartsListRows
                        If oRow.Visible = True Then
                            'gets the flatBOM fields from parts list
                            ComponentNo = oRow.Item(oPartsList.PartsListColumns.Item(5)).Value
                            QtyCar = oRow.Item(oPartsList.PartsListColumns.Item(2)).Value
                            NxtAsy = oRow.Item(oPartsList.PartsListColumns.Item(4)).Value
                            Call GetTitleBlockStuff(Titl, ShtSz, DwgNo, Rvz, ComponentNo, MtlSpec, MtlType, QtyCar, NxtAsy, filepath)
                        End If
                    Next
                End If
            Next
            Call GetSpecialtyItems(SpecPrtDesc, SpecPrtNo, SpecQtyCar)
        Else
        Call GetTitleBlockStuff(Titl, ShtSz, DwgNo, Rvz, ComponentNo, MtlSpec, MtlType, QtyCar, NxtAsy, filepath)
        End If
    Case Else 'Not "A", "M" or "Q"
    'CASE FOR ALL PART DRAWINGS
    
        i = oSheet.PartsLists.Count
            If i > 0 Then
                Set oPartLists = oSheet.PartsLists
                Set oPartsList = oSheet.PartsLists.Item(1)
                j = oPartsList.PartsListRows.Count
                k = oPartsList.PartsListColumns.Count
                'iterates through part list row, gets fields for flatBOM,
                'calls TitleBlockStuff, goes to next row
                    For m = 1 To oPartsList.PartsListRows.Count
                        'selects first row in parts list
                        Set oRow = oPartsList.PartsListRows.Item(m)
                        If oRow.Visible = True Then
                            For Each oColumn In oPartsList.PartsListColumns
                                Select Case oColumn.Title
                                    'gets flatBOM info from this row of parts list
                                    Case Is = "PART NO."
                                        ComponentNo = oRow.Item(oColumn).Value
                                    Case Is = "PART DESCRIPTION"
                                        MtlSpec = oRow.Item(oColumn).Value
                                    Case Is = "MATERIAL"
                                        MtlType = oRow.Item(oColumn).Value
                                    're-ported to look for "QTY./" to correct for non-car designs
                                    'Case Is = "QTY./CAR"
                                        'QtyCar = oRow.Item(oColumn).Value
                                    Case Is = "NEXT ASSY./APPL."
                                        NxtAsy = oRow.Item(oColumn).Value
                                End Select
                                're-ported to look for "QTY./" to correct for non-car designs
                                If Left(oColumn.Title, 5) = "QTY./" Then
                                    'MsgBox "poopeeee"
                                    QtyCar = oRow.Item(oColumn).Value
                                End If
                            Next
                            'calls to fill row of flatBOM with this
                            Call GetTitleBlockStuff(Titl, ShtSz, DwgNo, Rvz, ComponentNo, MtlSpec, MtlType, QtyCar, NxtAsy, filepath)
                        End If
                    Next
            Else
            'if there are no partslists in the drawing, calls TitleBlockStuff
                Call GetTitleBlockStuff(Titl, ShtSz, DwgNo, Rvz, ComponentNo, MtlSpec, MtlType, QtyCar, NxtAsy, filepath)
            End If
End Select
End Sub
Private Sub GetPartNum(DwgNo, partnumtype)
'DOCUMENTED AND COMMENTED 02OCT13
'------------------------------------------------------------------
'GETS THE STARFIRE "DRAWING NUMBER" (15020-A001.dwg) AND STORES AS "DwgNo"
'ITERATES THROUGH THE STARFIRE "DRAWING NUMBER" AND LOCATES THE DRAWING TYPE (A, Q, M, OR other)
'AND STORES AS "partnumtype"... 02Mar16
'------------------------------------------------------------------
Dim j As String
DwgNo = Left((odoc.DisplayName), 10)
j = Mid(DwgNo, 7, 1)
partnumtype = j
End Sub
Private Sub GetSpecialtyItems(SpecPrtDesc, SpecPrtNo, SpecQtyCar)
'DOCUMENTED AND COMMENTED 02OCT13
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim m As Long
Dim oPartLists As PartsLists
Dim partlistrowcount As Integer
Dim partlistcolumncount As Integer
Dim RowArray As String
Dim oPartsList As PartsList
Dim oRow As PartsListRow
Dim oColumn As PartsListColumn

'ALL THREE ("A", "M", AND "Q") SEEM TO BE THE SAME....

Select Case partnumtype
    Case "A"
        i = oSheet.PartsLists.Count
        Set oPartLists = oSheet.PartsLists
        Set oPartsList = oSheet.PartsLists.Item(i)
        i = oPartsList.PartsListRows.Count
        j = oPartsList.PartsListColumns.Count
        If oSheet.PartsLists.Count > 0 Then
        For i = 1 To oSheet.PartsLists.Count
            If oSheet.PartsLists.Item(i).ShowTitle = True Then
                Set oPartsList = oSheet.PartsLists.Item(i)
                If oPartsList.Title = "ASSEMBLY LIST" Then
                For j = 1 To oPartsList.PartsListColumns.Count
                    If oPartsList.PartsListColumns.Item(j).Title = "REF. DRAWING" Then
                        For Each oRow In oPartsList.PartsListRows
                            If oRow.Visible = True Then
                                If oRow.Item(oPartsList.PartsListColumns.Item(j)).Value = "-" Then
                                    For Each oColumn In oPartsList.PartsListColumns
                                        Select Case oColumn.Title
                                            Case Is = "DESCRIPTION"
                                                SpecPrtDesc = oRow.Item(oColumn).Value
                                            Case Is = "PART NO."
                                                SpecPrtNo = oRow.Item(oColumn).Value
                                                k = Len(SpecPrtNo)
                                                For l = 1 To k
                                                    If Asc(Left((SpecPrtNo), 1)) = 48 Then
                                                        SpecPrtNo = Right(SpecPrtNo, (Len(SpecPrtNo) - 1))
                                                    Else: l = k
                                                    End If
                                                Next
                                            Case Is = "QTY./ASSY."
                                                SpecQtyCar = oRow.Item(oColumn).Value
                                                If IsNumeric(SpecQtyCar) = False Then
                                                SpecQtyCar = 0
                                                End If
                                        End Select
                                    Next
                                    Call WriteSpecList(fltBOMLine, specListLine, Titl, ShtSz, DwgNo, Rvz, ComponentNo, MtlSpec, MtlType, QtyCar, NxtAsy, SpecPrtDesc, SpecPrtNo, SpecQtyCar)
                                End If
                            End If
                        Next
                    End If
                Next
                End If
            End If
        Next
        End If
        
Case "M"
        i = oSheet.PartsLists.Count
        Set oPartLists = oSheet.PartsLists
        Set oPartsList = oSheet.PartsLists.Item(i)
        i = oPartsList.PartsListRows.Count
        j = oPartsList.PartsListColumns.Count
        If oSheet.PartsLists.Count > 0 Then
        For i = 1 To oSheet.PartsLists.Count
            If oSheet.PartsLists.Item(i).ShowTitle = True Then
                Set oPartsList = oSheet.PartsLists.Item(i)
                If oPartsList.Title = "ASSEMBLY LIST" Then
                For j = 1 To oPartsList.PartsListColumns.Count
                    If oPartsList.PartsListColumns.Item(j).Title = "REF. DRAWING" Then
                        For Each oRow In oPartsList.PartsListRows
                            If oRow.Visible = True Then
                                If oRow.Item(oPartsList.PartsListColumns.Item(j)).Value = "-" Then
                                    For Each oColumn In oPartsList.PartsListColumns
                                        Select Case oColumn.Title
                                            Case Is = "DESCRIPTION"
                                                SpecPrtDesc = oRow.Item(oColumn).Value
                                            Case Is = "PART NO."
                                                SpecPrtNo = oRow.Item(oColumn).Value
                                                k = Len(SpecPrtNo)
                                                For l = 1 To k
                                                    If Asc(Left((SpecPrtNo), 1)) = 48 Then
                                                        SpecPrtNo = Right(SpecPrtNo, (Len(SpecPrtNo) - 1))
                                                    Else: l = k
                                                    End If
                                                Next
                                            Case Is = "QTY./ASSY."
                                                SpecQtyCar = oRow.Item(oColumn).Value
                                                If IsNumeric(SpecQtyCar) = False Then
                                                SpecQtyCar = 0
                                                End If
                                        End Select
                                    Next
                                    Call WriteSpecList(fltBOMLine, specListLine, Titl, ShtSz, DwgNo, Rvz, ComponentNo, MtlSpec, MtlType, QtyCar, NxtAsy, SpecPrtDesc, SpecPrtNo, SpecQtyCar)
                                End If
                            End If
                        Next
                    End If
                Next
                End If
            End If
        Next
        End If

Case "Q"
        i = oSheet.PartsLists.Count
        Set oPartLists = oSheet.PartsLists
        Set oPartsList = oSheet.PartsLists.Item(i)
        i = oPartsList.PartsListRows.Count
        j = oPartsList.PartsListColumns.Count
        If oSheet.PartsLists.Count > 0 Then
        For i = 1 To oSheet.PartsLists.Count
            If oSheet.PartsLists.Item(i).ShowTitle = True Then
                Set oPartsList = oSheet.PartsLists.Item(i)
                If oPartsList.Title = "ASSEMBLY LIST" Then
                For j = 1 To oPartsList.PartsListColumns.Count
                    If oPartsList.PartsListColumns.Item(j).Title = "REF. DRAWING" Then
                        For Each oRow In oPartsList.PartsListRows
                            If oRow.Visible = True Then
                                If oRow.Item(oPartsList.PartsListColumns.Item(j)).Value = "-" Then
                                    For Each oColumn In oPartsList.PartsListColumns
                                        Select Case oColumn.Title
                                            Case Is = "DESCRIPTION"
                                                SpecPrtDesc = oRow.Item(oColumn).Value
                                            Case Is = "PART NO."
                                                SpecPrtNo = oRow.Item(oColumn).Value
                                                k = Len(SpecPrtNo)
                                                For l = 1 To k
                                                    If Asc(Left((SpecPrtNo), 1)) = 48 Then
                                                        SpecPrtNo = Right(SpecPrtNo, (Len(SpecPrtNo) - 1))
                                                    Else: l = k
                                                    End If
                                                Next
                                            Case Is = "QTY./ASSY."
                                                SpecQtyCar = oRow.Item(oColumn).Value
                                                If IsNumeric(SpecQtyCar) = False Then
                                                SpecQtyCar = 0
                                                End If
                                        End Select
                                    Next
                                    Call WriteSpecList(fltBOMLine, specListLine, Titl, ShtSz, DwgNo, Rvz, ComponentNo, MtlSpec, MtlType, QtyCar, NxtAsy, SpecPrtDesc, SpecPrtNo, SpecQtyCar)
                                End If
                            End If
                        Next
                    End If
                Next
                End If
            End If
        Next
        End If


    Case Else 'Not "A", "M" or "Q"
    'IF IT IS A PART DRAWING IT CAN'T HAVE A SPECIALTY ITEM
End Select

End Sub

Private Sub GetTitleBlockStuff(Titl, ShtSz, DwgNo, Rvz, ComponentNo, MtlSpec, MtlType, QtyCar, NxtAsy, filepath)
Dim oTextBox As TextBox
Dim i As Long
Dim j As Long
Dim k As Long
Dim oPartLists As PartsLists
Dim partlistrowcount As Integer
Dim partlistcolumncount As Integer
Dim RowArray As String
Dim oPartsList As PartsList
Dim oRow As PartsListRow
Dim oColumn As PartsListColumn
'**********************************************************************
'****************MADE A CHANGE HERE 12AUG15***************************
'*********************************************************************
i = odoc.TitleBlockDefinitions.Count
'Set oTitlBlkDef = oDoc.TitleBlockDefinitions.Item("starfire_typ")*COMMENTED THIS OUT
Set oTitlBlk = odoc.ActiveSheet.TitleBlock
Set oTitlBlkDef = odoc.TitleBlockDefinitions.Item(oTitlBlk.Name) 'oDoc.TitleBlockDefinitions.Item("starfire_typ")*CHANGED THIS
Set oBrdr = odoc.ActiveSheet.Border
'i = oDoc.TitleBlockDefinitions.Item("starfire_typ").Sketch.TextBoxes.Count*COMMENTED THIS OUT
    For Each oTextBox In oTitlBlkDef.Sketch.TextBoxes  'oDoc.TitleBlockDefinitions.Item("starfire_typ").Sketch.TextBoxes*CHANGED THIS
        Select Case oTextBox.Text
            Case "<TITLE>"
                Titl = oTitlBlk.GetResultText(oTextBox)
            Case "<STOCK NUMBER>"
                DwgNo = oTitlBlk.GetResultText(oTextBox)
                'ComponentNo = Right(DwgNo, 4) 'MIGHT WANNA GET THIS OUT OF THE PARTS LIST
            Case "<REVISION NUMBER>"
                Rvz = oTitlBlk.GetResultText(oTextBox)
            Case Else
            End Select
    Next
    For Each oTextBox In odoc.BorderDefinitions.Item(oBrdr.Name).Sketch.TextBoxes  'odoc.TitleBlockDefinitions.Item("ANSI - Large").Sketch.TextBoxes
        Select Case oTextBox.Text
            Case "<Sheet Size>"
                ShtSz = oBrdr.GetResultText(oTextBox)
            Case Else
            End Select
    Next
    Call WriteFlatBOM(fltBOMLine, specListLine, Titl, ShtSz, DwgNo, Rvz, ComponentNo, MtlSpec, MtlType, QtyCar, NxtAsy, SpecPrtDesc, SpecPrtNo, SpecQtyCar, filepath)

End Sub
Private Sub GetPartsListStuff()

End Sub
Private Sub WriteFlatBOM(fltBOMLine, specListLine, Titl, ShtSz, DwgNo, Rvz, ComponentNo, MtlSpec, MtlType, QtyCar, NxtAsy, SpecPrtDesc, SpecPrtNo, SpecQtyCar, filepath)

    Set oCalcSheet = oCalcDoc.getSheets().GetByName("BOM")
    
    Call oCalcSheet.getCellByPosition(0, fltBOMLine).SetFormula(Titl)
    
    Call oCalcSheet.getCellByPosition(1, fltBOMLine).SetFormula("STARFIRE")
    
    Call oCalcSheet.getCellByPosition(2, fltBOMLine).SetFormula(DwgNo)
    
    Call oCalcSheet.getCellByPosition(3, fltBOMLine).SetFormula(ShtSz)
    
    Call oCalcSheet.getCellByPosition(4, fltBOMLine).SetFormula(Rvz)
        
    Call oCalcSheet.getCellByPosition(5, fltBOMLine).SetFormula(ComponentNo)
    
    Call oCalcSheet.getCellByPosition(6, fltBOMLine).SetFormula(MtlSpec)
    
    Call oCalcSheet.getCellByPosition(7, fltBOMLine).SetFormula(MtlType)
    
    Call oCalcSheet.getCellByPosition(8, fltBOMLine).SetFormula(QtyCar)
    
    Call oCalcSheet.getCellByPosition(9, fltBOMLine).SetFormula(NxtAsy)
    
    Call oCalcSheet.getCellByPosition(11, fltBOMLine).SetFormula(filepath)
    
    fltBOMLine = fltBOMLine + 1

End Sub
    
Private Sub WriteSpecList(fltBOMLine, specListLine, Titl, ShtSz, DwgNo, Rvz, ComponentNo, MtlSpec, MtlType, QtyCar, NxtAsy, SpecPrtDesc, SpecPrtNo, SpecQtyCar)

Dim specQtyLookup As Integer
Dim NewSpecQtyCar As Integer
Dim Cellval As Variant
Dim Cellval2 As Variant
Dim QtyVal As Variant
Dim LFcell1 As Object
Dim LFcell2 As Object
Dim LFcell3 As Object

'GETS "ASSY/CAR" NOTE QTY FOR MULTIPLIER IN SPECIALTY LIST
Dim xx As Long
Dim TB As TextBox
Dim SkSym As SketchedSymbol
Dim SkSymCount As Integer
Dim SkSymText As String
Dim SkSymVal As Integer
SkSymCount = oSheet.SketchedSymbols.Count
For xx = 1 To oSheet.SketchedSymbols.Count
Set SkSym = oSheet.SketchedSymbols.Item(xx)
If oSheet.SketchedSymbols.Item(xx).Name = "Assemblies/Car" Then
    'MsgBox SkSym.Definition.Sketch.TextBoxes.Count
    For Each TB In SkSym.Definition.Sketch.TextBoxes '.Item(xx)
        SkSymText = oSheet.SketchedSymbols.Item(xx).GetResultText(TB)
        If SkSymText <> "ASSEMBLIES/CAR:" Then
            'MsgBox SkSymText
            SkSymVal = oSheet.SketchedSymbols.Item(xx).GetResultText(TB)
            'MsgBox SkSymVal
                'MsgBox Asc(Left(SkSymVal, 1))
                If Asc(Left(SkSymVal, 1)) >= 48 And Asc(Left(SkSymVal, 1)) <= 57 Then
                'OUT!!! SkSymVal = SkSymVal + 1
                'MsgBox Asc(Left(SkSymVal, 1))
                'MsgBox SkSymVal
                AsyPerCar = SkSymVal
            End If
        End If
    Next
End If
Next

'GETS "QTY/CAR" QUANTITY FROM SECOND ASSEMBLY LIST FOR MULTIPLIER IN SPECIALTY LIST
Dim oPartLists As PartsLists
Dim oPartsList As PartsList
Dim oRow As PartsListRow
Dim oColumn As PartsListColumn

Dim QtyNxtAsy As Integer
Dim RowsNxtAsy As Integer
Dim PrtLstNxtAsy As Integer
If oSheet.PartsLists.Count > 0 Then

    'gets a count of part lists
    For PrtLstNxtAsy = 1 To oSheet.PartsLists.Count
        Set oPartsList = oSheet.PartsLists.Item(PrtLstNxtAsy)
        'iterates through parts list until it finds the one for the Next Assembly
        If oPartsList.PartsListColumns.Item(4).Title = "NEXT ASSY./APPL." Then
            RowsNxtAsy = oPartsList.PartsListRows.Count
            For Each oRow In oPartsList.PartsListRows
                If oRow.Visible = True Then
                    QtyNxtAsy = QtyNxtAsy + oRow.Item(oPartsList.PartsListColumns.Item(2)).Value
                    AsyPerCar = QtyNxtAsy
                End If
            Next
        End If
    Next
Else
End If

If AsyPerCar <> 0 Then
    SpecQtyCar = SpecQtyCar * AsyPerCar
End If
    Set oCalcSheet = oCalcDoc.getSheets().GetByName("SPECIALTY") '.GetByIndex(0)
    For specQtyLookup = 0 To specListLine
        Set LFcell1 = oCalcSheet.getCellByPosition(2, specQtyLookup)
        Set LFcell2 = oCalcSheet.getCellByPosition(1, specQtyLookup)
        Cellval = LFcell1.String
        Cellval2 = LFcell2.String
        If Cellval = SpecPrtDesc And Cellval2 = SpecPrtNo Then
            Set LFcell3 = oCalcSheet.getCellByPosition(3, specQtyLookup)
            QtyVal = LFcell3.Value
            NewSpecQtyCar = QtyVal + SpecQtyCar
            Call oCalcSheet.getCellByPosition(3, specQtyLookup).SetFormula(NewSpecQtyCar)
            specQtyLookup = specListLine
        End If
    Next
    If NewSpecQtyCar = 0 Then
        Call oCalcSheet.getCellByPosition(2, specListLine).SetFormula(SpecPrtDesc)
    
        Call oCalcSheet.getCellByPosition(1, specListLine).SetFormula(SpecPrtNo)
    
        Call oCalcSheet.getCellByPosition(3, specListLine).SetFormula(SpecQtyCar)
        
        specListLine = specListLine + 1
        
    Else
    End If
   
    
    
End Sub

Private Sub CloseDwg(thing)
'MsgBox " "
ThisApplication.SilentOperation = True
odoc.Close
ThisApplication.SilentOperation = False

End Sub


0 Likes
Message 6 of 13

Owner2229
Advisor
Advisor

Hi, I've made a spring cleaning in your code and it went from 952 down to 609 lines of code 😄

(While still keeping most of your comments)

 

Can you please test it out, before I'll continue? I want to be sure I didn't break something.

Rather test it on some non-critical data, so it won't mess your documents.

 

Anyway there's still way too much Global variables (Private variables now).

 

Consider using "Accept as Solution" / "Kudos" if you find this helpful.
- - - - - - - - - - - - - - -
Regards,
Mike

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live." - John F. Woods
0 Likes
Message 7 of 13

Anonymous
Not applicable

Wow, Mike, I didn't expect you to do that!  Thanks, though, I'll load it up and give it a test!  I've got a question regarding the Global/Private vairable dimensioning, I thought the dim had to be Global to pass it from one Sub to another...?  Thanx again!

0 Likes
Message 8 of 13

Owner2229
Advisor
Advisor

Hi, declaring variable as "Private" means it will "only" be accesible from this rule / makro / class.

On the other hand declaring it as "Global" or "Public" it will be accesible from outside of the rule / makro / class.

It can be used e.g. if you want to call an function in one rule from another or run another rule and return an variable from it.

 

It's good to keep them private as long as you dont need to expose them for an another rule, as it could cause some issues if you'll have declared new variables in new rule with the same names.

Consider using "Accept as Solution" / "Kudos" if you find this helpful.
- - - - - - - - - - - - - - -
Regards,
Mike

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live." - John F. Woods
0 Likes
Message 9 of 13

Anonymous
Not applicable

Hi, Mike.  Reading back over my post, I left out an important piece.  I'm working in Inventor R2011, which may make a big difference in the code.  I've loaded the code you sent and ran it.  It has some errors, but before we go any farther, does the ancient release of Inventor and, presumably VBA, make a difference in the code that can be used?  Thanx.

0 Likes
Message 10 of 13

Owner2229
Advisor
Advisor

Hi, you have already mentioned you're ussing Inventor 2011 and Win XP.

There sure are some differencies and functions we can't use, but on level that's beyond opening some DWGs and OpenOffice sheets.

 

Can you please give me some info about where the code fails? Rows would be the best.

Consider using "Accept as Solution" / "Kudos" if you find this helpful.
- - - - - - - - - - - - - - -
Regards,
Mike

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live." - John F. Woods
Message 11 of 13

Anonymous
Not applicable

Hi, Mike.

I haven't had a lot of time to work with this, we've been busier than a one-handed juggler!  I've attached a screen shot of the error.  Also, VBA doesn't seem to be recognizing the "Private Sub oFileDialog" as a sub-routine.  It doesn't have a separation line before it, and it's red.  That's what made me wonder if that type of dimensioning wasn't allowed in the version of VBA I have.  Also, you mentioned telling you the row the error is in... is there a way to display the code with the rows numbered?  Thanks for helping with this!

0 Likes
Message 12 of 13

rossano_praderi
Collaborator
Collaborator
Accepted solution

Hi LonesomeJoe,

 

You had the impression that your code has worked fine for all the time, but was only a mix of random situations.

 

Subroutines ("Sub") doesn't return a value, can do many things but doesn't return any value.

 

To return a value you have to use a "Function", which is designed to return values

 

I haven't read all your code, but this is why you get this error.

 

If you like to have the line number which contain the error you can use the "erl" function.

for reference follow this link https://msdn.microsoft.com/it-it/library/97sx19w1(v=vs.90).aspx

 

The follow is an example on how to use it

 

ON ERROR GOTO MYERROR

....BLAH....BLAH....

MYERROR:
MsgBox "Error on line : " & Erl

 

Bregs

Rossano Praderi



--------------------------------------
If my post answers your question, please click the "Accept as Solution"
button. This helps everyone find answers more quickly!
---------------
Message 13 of 13

Anonymous
Not applicable

Hi, Rossano!  Thanx for the help!  I changed the "Private Sub" to "Private Function", and added a missing "End If" statement and the code runs.  I have to run it through a battery of tests to see if there's any other issues. 

 

Public Sub fillFlatBOM()
    On Error GoTo ErrorHandler 'goes to END if no flatBOM or no dwgs
    'DOCUMENTED AND COMMENTED 02OCT13
    '------------------------------------------------------------------
    'CALLS THE FILE DIALOG OPEN FOR THE OpenOffice SPREADSHEET.  OPENS A FILE DIALOG TO SURF TO AND
    'SELECT THE flatBOM SPREADSHEET; THEN STORES THE PATH TO THE SPREADSHEET IN A VARIABLE... 02Mar16
    '------------------------------------------------------------------
    
    strFileName2 = oFileDialog("Spreadsheet")

    'initializes Used Rows to 0
    '------------------------------------------------------------------
    'OpenOffice Calc DOESN'T HAVE A "USED RANGE" FUNCTION SO THIS IS NEEDED TO INITIALIZE THE "ACTIVE ROW"
    'TO "0" FOR THE "USED ROWS" CODE... 02Mar16
    '------------------------------------------------------------------
    fltBOMLine = 0
    specListLine = 0

    '------------------------------------------------------------------
    'CALLS THE CODE TO OPEN OpenOffice Calc.  "URLEncode(strFileName2)" TAKES THE PATH STRING RETURNED
    'FROM THE FILE DIALOG AND FORMATS THE PATH STRING INTO THE WONKY FORMAT OpenOffice USES FOR ITS URL;
    '"oDesktop.loadComponentFromURL" LOADS (?OPENS?) SPREADSHEET USING THE REFORMATTED PATH;
    '"GetUsdRngSpec(fltBOMLine, 0)" ITERATES THROUGH THE "BOM" WORKSHEET AND COUNTS THE USED ROWS, THIS
    'ALLOWS ADDING NEW ROWS ONTO AN EXISTING SPREADSHEET; "GetUsdRngSpec(specListLine, 3)" ITERATES THROUGH
    ' THE "SPECIALTY" WORKSHEET 7 DOES SAME... 02Mar16
    '------------------------------------------------------------------
    Call OpenCalc
    strFolderName = oFileDialog("Drawings")
    strFolderName = Left$(strFolderName, InStrRev(strFolderName, "\") - 1)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFiles = fso.GetFolder(strFolderName).Files
    Call OpenDwgs
    
    MsgBox "Done!"

    Exit Sub
ErrorHandler:
    MsgBox "An Error Has Occurred; The Program Will Terminate. Drawing" & thing.Name, vbInformation
End Sub

Private Function oFileDialog(oTarget As String) As String
    Dim oFileDlg As FileDialog
    Call ThisApplication.CreateFileDialog(oFileDlg) ' Create a new FileDialog object.
    oFileDlg.Filename = ""
    If oTarget = "Spreadsheet" Then
        oFileDlg.DialogTitle = "Find a flatBOM Spreadsheet" ' Set the title for the dialog.
        oFileDlg.Filter = "OpenOffice Files (*.ods)|*.ods|All Files (*.*)|*.*" ' Define the filter to select part and assembly files or any file.
        Else
            If oTarget = "Drawings" Then
                oFileDlg.Filter = "Inventor Files (*.dwg)|*.dwg|All Files (*.*)|*.*"
                oFileDlg.DialogTitle = "Find a Drawing"
            End If
    End If
        oFileDlg.FilterIndex = 1 ' Define the part and assembly files filter to be the default filter.
        oFileDlg.InitialDirectory = "Y:\LIB_NVTR\VBA\Files for OpenOffice flatBOM Test 02Mar16" ' Set the initial directory that will be displayed in the dialog.
        oFileDlg.CancelError = True ' Set the flag so an error will be raised if the user clicks the Cancel button.
        On Error Resume Next
        oFileDlg.ShowOpen ' Show the open dialog. The commented code can be used for the Save dialog.
    'oFileDlg.ShowSave

    If Err Then ' If an error was raised, the user clicked cancel, otherwise display the filename.
        MsgBox "User cancelled out of dialog"
        Else
            If oFileDlg.Filename = "" Then
                MsgBox "File " & oFileDlg.Filename & " was selected."
            End If
    End If
    oFileDialog = oFileDlg.Filename
End Function

 

The error trap discussed earlier solves my initial problem with the "Invalid Template", so I'm going to mark this "Solved".  Thanx for everyone's help!!!

 

Ed

0 Likes