Opening an ACAD dwg file in opened ACAD application with vba - vba

Question

I have an excel file with part numbers listed in a column. On running, the code splits the first part number typed. From the first half the code finds the subfolder that contains that category of part numbers then the second half is the actual file name. Example 01T-1001-01. 01T is the subfolder name and the 1001-01 is the file name, it splits at -. However sometimes descriptions of the part are added in parenthesis so for example 1001-01 (Chuck). That is what the wild card is for.
The code is supposed to first check if AutoCAD is opened, if so then open the dwg in the opened AutoCAD application, if not then open a new application.
The issue is that it will open one drawing (first in the list) but will error out with "Run time error '438': Object doesn't support this property or method" It will not continue past Set ACADApp.ActiveDocument = ACADApp.Documents.Open(ACADPath) to open the other dwgs in the list
UPDATED Code below:
Dim ACADApp As AcadApplication
Dim ACADPath As String
Dim ACAD As Object
Dim NFile As Object
Sub Open_Dwg()
Dim Wildcard As String
Dim path As String
Dim target As String
Dim SplitString() As String
Dim i As Integer
Dim a As Integer
i = 1
If ACAD Is Nothing Then
Set ACAD = CreateObject("AutoCad.Application")
If ACAD Is Nothing Then
MsgBox "Could not start AutoCAD.", vbCritical
Exit Sub
End If
Else
Set ACAD = GetObject(, "AutoCAD.Application")
End If
Set ACADApp = ACAD
ACADApp.Visible = True
Do Until Cells(i, 1).Value = ""
ACADPath = ""
Wildcard = ""
OpenString = ""
path = "C:\Users\aholiday\Desktop\DEMO" 'Root Folder
target = Cells(i, 1).Value 'Get Targeted Cell Value
target = UCase(target) 'All Letters to Upper Case
SplitString() = Split(target, "-", 2) 'Split given name to obtain subfolder and name
path = path & "\" & SplitString(0) & "\" 'Build Complete Path
OpenString = path & SplitString(1) & ".dwg" 'File Path and Name
Wildcard = Dir(path & SplitString(1) & "*.dwg") 'File Path and Wildcard
If Dir(OpenString) <> "" Then
ACADPath = OpenString
OpenFile (ACADPath)
Else
If Wildcard <> "" Then 'If Not Then Use Wildcard
ACADPath = path & Wildcard
OpenFile (ACADPath)
Else
MsgBox ("File " & target & " Not Found")
End If
End If
i = i + 1
Loop
End Sub
Function OpenFile(ByVal ACADPath As String) As String
Set ACADApp.ActiveDocument = ACADApp.Documents.Open(ACADPath)
End Function

Answer 1

Here is a basic shell of what I use in our production application:
Sub Open_Dwg()
On Error Resume Next
Dim ACADApp As AcadApplication
Dim a As Object
Set a = GetObject(, "AutoCAD.Application")
If a Is Nothing Then
Set a = CreateObject("AutoCAD.Application")
If a Is Nothing Then
MsgBox "AutoCAD must be running before performing this action.", vbCritical
Exit Sub
End If
End If
Set ACADApp = a
ACADApp.Visible = True
Set ACADApp.ActiveDocument = ACADApp.Documents.Open("<your filename>")
End Sub
Note the modification of the GetObject call and how the document is being opened.
EDIT:
Using the above code as a starting point and applying it to the OP's code, you would end up with the following:
Option Explicit
Dim ACADApp As AcadApplication
Dim ACADPath As String
Dim ACAD As Object
Dim NFile As Object
Sub Open_Dwg()
Dim Wildcard As String
Dim OpenString As String
Dim path As String
Dim target As String
Dim SplitString() As String
Dim i As Integer
Dim a As Integer
'get or create an instance of autocad
On Error Resume Next
Set ACAD = Nothing
Set ACAD = GetObject(, "AutoCAD.Application")
If ACAD Is Nothing Then
Set ACAD = CreateObject("AutoCad.Application")
If ACAD Is Nothing Then
MsgBox "Could not start AutoCAD.", vbCritical
Exit Sub
End If
End If
Set ACADApp = ACAD
ACADApp.Visible = True
On Error GoTo 0
'process files
i = 1
Do Until Cells(i, 1).Value = ""
path = "C:\Users\aholiday\Desktop\DEMO" 'Root Folder
target = UCase(Cells(i, 1).Value) 'Get Targeted Cell Value
SplitString() = Split(target, "-", 2) 'Split given name to obtain subfolder and name
path = path & "\" & SplitString(0) & "\" 'Build Complete Path
OpenString = path & SplitString(1) & ".dwg" 'File Path and Name
Wildcard = Dir(path & SplitString(1) & "*.dwg") 'File Path and Wildcard
If Dir(OpenString) <> "" Then
OpenFile OpenString
Else
If Wildcard <> "" Then 'If Not Then Use Wildcard
OpenFile path & Wildcard
Else
MsgBox ("File " & target & " Not Found")
End If
End If
i = i + 1
Loop
End Sub
Function OpenFile(ByVal ACADPath As String) As String
ACADApp.Documents.Open ACADPath
End Function