Hello, I have slightly adjusted the code in this thread to handle errors in my VBA/SAS code. The problem is that some errors are not trapped such as Open code statement recursion detected. On the other hand some other errors not being indicated in SAS Entreprise Guide occur, such as Format DATEMMYYP could not be loaded. Any help would be greatly appreciated. Petr Sub test() Dim obObjectFactory As New SASObjectManager.ObjectFactory Dim obObjectKeeper As New SASObjectManager.ObjectKeeper Dim obServer As New SASObjectManager.ServerDef Dim obSAS As SAS.workspace Dim logLines() As String Dim carriageControls() As SAS.LanguageServiceCarriageControl Dim lineTypes() As SAS.LanguageServiceLineType Dim line As Variant Dim logbuffer As String Dim numlines As Long obServer.MachineDNSName = "sas_server" obServer.Protocol = SASObjectManager.Protocols.ProtocolBridge obServer.Port = 8591 obObjectFactory.LogEnabled = True Application.DisplayAlerts = False Set obSAS = obObjectFactory.CreateObjectByServer("sas", True, obServer, "user_id", "password") Set obLS = obSAS.LanguageService StrSAS = FileContents2("C:\TEMP\bene+\Fakturace\bene_SAS\sas_code.txt") ' SAS code here, I use function FileContents2 to load contents into variable ' Debug.Print StrSAS obLS.Submit StrSAS ' Search the SAS log for an instance of a SAS ERROR message. numlines = 900000 obSAS.LanguageService.FlushLogLines numlines, carriageControls, lineTypes, logLines For Each line In logLines logbuffer = logbuffer & line & vbCrLf If InStr(1, logbuffer, "ERROR:") Then ' Debug.Print logbuffer GoTo ErrHandler End If Next line ' Close connection to SAS server if process runs successfully. GoodEnd: If Not (obSAS Is Nothing) Then obSAS.Close End If Exit Sub ' Display message box showing SAS ERROR message if found. Close connection to SAS server. ErrHandler: MsgBox "Fatal Error in Stored Process Execution " & logbuffer, vbCritical If Not (obSAS Is Nothing) Then obSAS.Close End If End Sub Function FileContents2(FileSpec As Variant, _ Optional ReturnErrors As Boolean = False, _ Optional ByRef ErrCode As Long) As Variant 'Retrieves contents of file as a string 'Silently returns Null on error unless ' ReturnErrors is true, in which case ' uses CVErr() to return an error value. ' Optionally, you can retrieve the error ' code in the ErrCode argument Dim lngFN As Long On Error GoTo Err_FileContents If IsNull(FileSpec) Then FileContents2 = Null Else lngFN = FreeFile() Open FileSpec For Input As #lngFN FileContents2 = Input(LOF(lngFN), #lngFN) End If ErrCode = 0 GoTo Exit_FileContents Err_FileContents: ErrCode = Err.Number If ReturnErrors Then FileContents2 = CVErr(Err.Number) Else FileContents2 = Null End If Err.Clear Exit_FileContents: Close #lngFN End Function
... View more
