Here is what I neophyte in VB used some time ago...
Option Explicit
Option Compare Text
Declare Function RegQueryValueEx& Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey&, ByVal lpszValueName$, ByVal lpdwRes&, lpdwType&, ByVal lpDataBuff$, nSize&)
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As _
String, ByVal lpszFile As String, ByVal lpszParams As String, _
ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_CLASSES_ROOT = &H80000000
Const KEY_QUERY_VALUE = &H1&
Const KEY_ENUMERATE_SUB_KEYS = &H8&
Const KEY_NOTIFY = &H10&
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = READ_CONTROL
Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Const SW_SHOWNORMAL = 1
Const SE_ERR_FNF = 2&
Const SE_ERR_PNF = 3&
Const SE_ERR_ACCESSDENIED = 5&
Const SE_ERR_OOM = 8&
Const SE_ERR_DLLNOTFOUND = 32&
Const SE_ERR_SHARE = 26&
Const SE_ERR_ASSOCINCOMPLETE = 27&
Const SE_ERR_DDETIMEOUT = 28&
Const SE_ERR_DDEFAIL = 29&
Const SE_ERR_DDEBUSY = 30&
Const SE_ERR_NOASSOC = 31&
Const ERROR_BAD_FORMAT = 11&
Private Function GetAppPath(subkey As String, sAppEntry As String) As String
Dim s As String * 255, sAppPath As String
Dim lAppKey As Long, lType As Long, lLen As Long, lRC As Long
lLen = Len(s)
lRC = RegOpenKeyEx(HKEY_CLASSES_ROOT, sAppEntry, 0, KEY_READ, lAppKey)
If lRC <> 0 Then Exit Function
lRC = RegQueryValueEx( _
lAppKey, _
subkey, _
0, _
lType, _
s, _
lLen)
's = Left$(s, lLen - 6)
GetAppPath = Mid(s, 2, lLen - 8) 'Left$(s, lLen - 5)
End Function
Function StartDoc(DocName As String, Param As String, Dir As String) As Long
Dim Scr_hDC As Long
Scr_hDC = GetDesktopWindow()
StartDoc = ShellExecute(Scr_hDC, "Open", DocName, _
Param, Dir, SW_SHOWNORMAL)
End Function
Sub Main()
Dim version As String
Dim result As Boolean
Dim sAcadEntry As String
On Error Resume Next
sAcadEntry = "AutoCAD.Drawing.16\shell\open\command"
version = GetAppPath("", sAcadEntry)
If StrConv(version, 1) Like "*ACAD.EXE" <> True Then
MsgBox ("El programa AutoCAD Ver. 2004 no se encuentra instalado. \nPor favor refiérase al Manual del Usuario.")
End
End If
'result = Shell(version & " /b draftteam.scr", 1)
Dim r As Long, msg As String, Dir As String
Dir = App.Path
r = StartDoc(version, " /b draftteam.scr", Dir)
If r <= 32 Then
'There was an error
Select Case r
Case SE_ERR_FNF
msg = "Archivo ejecutable de AutoCAD no encontrado."
Case SE_ERR_PNF
msg = "Ruta de AutoCADno encontrada"
Case SE_ERR_ACCESSDENIED
msg = "Acceso denegado de AutoCAD"
Case SE_ERR_OOM
msg = "Memoria insuficient"
Case SE_ERR_DLLNOTFOUND
msg = "DLL no encontrado"
Case SE_ERR_SHARE
msg = "Error de memoria"
Case SE_ERR_ASSOCINCOMPLETE
msg = "Incompleta o asociación de archivo inválida."
Case SE_ERR_DDETIMEOUT
msg = "DDE finalizó"
Case SE_ERR_DDEFAIL
msg = "Transacción DDE fallida."
Case SE_ERR_DDEBUSY
msg = "DDE ocupado"
Case SE_ERR_NOASSOC
msg = "No hay asociación para extensión de archivo."
Case ERROR_BAD_FORMAT
msg = "Ejecutable inválido."
Case Else
msg = "Error desconocido."
End Select
MsgBox msg
End
End If
'wait 20 seconds to let AutoCAD open
Dim TimeNow As Double
Dim TimeEnd As Double
TimeNow = Hour(Now()) + (Minute(Now()) / 60#) + (Second(Now()) / 3600#)
TimeEnd = TimeNow + (20# / 3600#)
Dim objAcad As Object
Set objAcad = GetObject(, "AutoCAD.Application")
While TimeNow < TimeEnd And (objAcad Is Nothing = True)
Set objAcad = GetObject(, "AutoCAD.Application")
TimeNow = Hour(Now()) + (Minute(Now()) / 60#) + (Second(Now()) / 3600#)
Wend
Dim preferences As Object
Set preferences = objAcad.preferences
Dim sPath As String
sPath = preferences.Files.SupportPath
If sPath <> "" Then
Dim DttPath As String
DttPath = objAcad.ActiveDocument.GetVariable("DWGPREFIX")
Dim LDttPath As Integer
LDttPath = Len(DttPath)
If Right(DttPath, 1) = "\" Then
DttPath = Left(DttPath, LDttPath - 1)
End If
'Add the path if does not exist
If StrConv(sPath, 1) Like "*" & StrConv(DttPath, 1) & "*" <> True Then
preferences.Files.SupportPath = sPath & ";" & DttPath
End If
End If
Set objAcad = Nothing
Set preferences = Nothing
End Sub
Then, having a filename.SCR to call a lisp file to be loaded....
HTH.