[Solved] Check if Databaseconnetion exists and refresh

[klausk]

I found two code snippets and a macro to check and refresh a connection to base

viewtopic.php?t=90535&hilit=Sub+RefreshDBRanges
viewtopic.php?t=91000&hilit=Sub+RefreshDBRanges

is there an alternative code to check if a database connection via Base exists or create a function?

Code: Select all

Sub RefreshDBRanges
   Dim oDBRangesEnum as Object
   Dim oNext as Object
   Dim Descriptor as Object
   Dim Dbr as Object
   Dim intCntDbr as Integer
   intCntDbr= 0
   
	for each dbr in thisComponent.DatabaseRanges()
		intCntDbr=intCntDbr+1
	next

	if intCntDbr > 0 then
	   
		oDBRangesEnum = thisComponent.DatabaseRanges.createEnumeration() 
		
		While oDBRangesEnum.hasMoreElements()
		              oNext = oDBRangesEnum.nextElement()   
		              Descriptor = oNext.getImportDescriptor() 
		              xray Descriptor
		              'Descriptor 0:DataBaseName  1:SourceType  2:SourceObject
		              MsgBox ("Datenbankquelle : "  & Descriptor(0).Value & "/" &_
		              Descriptor(2).Value & " - Type : " & Descriptor(1).Value )
		              'oNext.refresh()
		Wend
	else
	Msgbox("No DB-Connetion")
	end if
    
'MsgBox ("Update Complete", MB_OK, "UPDATE COMPLETE")  
End Sub

[klausk]

I found this solution:

Code: Select all

Sub ListDBRanges2
   Dim oDBRangesEnum as Object
   Dim oNext as Object
   Dim Descriptor as Object
   Dim strDB as String
   Dim intDB as Integer
 	intDB=thisComponent.DatabaseRanges().Count
	if intDB)< 1 then
	
	msgbox("In LO sind keine Datenbanken angemeldet")
	exit sub
	end if 
	   
	oDBRangesEnum = thisComponent.DatabaseRanges.createEnumeration() 
		
	While oDBRangesEnum.hasMoreElements()
		   oNext = oDBRangesEnum.nextElement()   
		   Descriptor = oNext.getImportDescriptor() 
		   strDB= ("--->  "+ Descriptor(0).Value & "/" &_ 
		   Descriptor(2).Value & " - Type : " & Descriptor(1).Value )+chr(13)+strDB
		   oNext.refresh()
	Wend    
MsgBox ("Folgdene Datenbankquelle sind in LO angemeldet: "+chr(13)  +strDB)  
End Sub