Home of site


Macroの杜
(OpenOffice.org/LibreOffice Basic編)

Base No.2

###【 Previous Page ( Base No.1 ) 】###


**********************【 Index 】**********************

HSQLDB : SQL( Query )


Firebird : SQL( Query )[ Development/Base/FirebirdSQL ] / [ Firebird 2.5 Language Reference Update ]


MySQL[Base]

[ Table ]



MS-ACCESS[Base]


Other[Base]













**********************【 Macro Code 】**********************

HSQLDB : SQL( Query )

BQ-)[Base-HSQLDB]Current FileにTable作成


Sub oSQL
	On Error Goto oBad
	' ***** [ 現在のBase File にTable作成 ] *****
	Dim oBaseContext as Object
	Dim oUser$
	Dim oPass$
	Dim oFlag as Integer
		oFlag = 0
		oUser$ = ""
		oPass$ = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		'
	' Connect with the DataSource
	Dim oDoc as Object
	Dim oBaseSrc as String
	Dim oDataSource as Object
	Dim oCon as Object
		oDoc = ThisComponent
		oBaseSrc = oDoc.getURL()
		oDataSource = oBaseContext.getByName(oBaseSrc)
		oCon = oDataSource.getConnection(oUser, oPass)
		oFlag = 777
		'
	Dim oStmt as Object
  	Dim oSQL as String
  	Dim oTbName as String
  		oTbName = "CITY_LIST"
  		oStmt = oCon.createStatement()
		oSQL = "CREATE TABLE " & oTbName & "(ID INTEGER,CITY_NAME VARCHAR(30)); "
		oStmt.execute(oSQL)
		'
	'Unconnect with the Datasource
		oCon.close()
		oCon.dispose
  		'
  	'  ********** [ 表示 → Tableの更新 ] **********
  	Dim dispatcher as Object
  	Dim oFrame as Object
  		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  		oFrame = oDoc.getCurrentController().getFrame()
  		dispatcher.executeDispatch(oFrame,".uno:DBRefreshTables", "", 0, Array())
  		'
  	' ****************************************
  	'
  	' Display
  		msgbox "Success"
		'
	Exit Sub
	oBad:
		if oFlag = 777 then
			oCon.close()
			oCon.dispose
		end if
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")		
End Sub

BQ-1)[Base-HSQLDB]任意のtable(名前:table1)の内容をすべて表示する。


Sub oBase_Query1
Dim db As Object
Dim oBase as String
	oBase ="oBase_test"
	db = connect_to_database(oBase)
	simple_query(db)
	disconnect_from_database(db)
End Sub

'[ Sub Routine1 ]
Sub disconnect_from_database ( db as Object)
	db.close
	db.dispose()
End Sub

'[ Sub Routine2 ]
Sub simple_query(db as Object)
Dim oSql As String
Dim i As Integer
Dim oRowSet As Object
Dim oResult As String
	oSql = "SELECT * FROM""table1"""
	oRowSet = createUnoService("com.sun.star.sdb.RowSet")
	With oRowSet
		.activeConnection = db
		.Command = oSql
		.execute
	End With
	While oRowSet.Next
		oResult = oResult & oRowset.getString(1)  & " " _
		 & capitalize(oRowset.getString(2) )  & " " _
		 & capitalize(oRowset.getString(3) )  & " " _
		 & capitalize(oRowset.getString(4) )  & " " _
		 & oRowset.getString(5) &chr(13)
	wend
	msgbox oResult,,"Macro_Query"
End Sub

'[ Function1 ]
Function connect_to_database(dbName as String) as Object
Dim dbContext As Object
Dim oDataSource As Object
	dbContext =createUnoService("com.sun.star.sdb.DatabaseContext")
	oDataSource= dbContext.getByName(dbName)
	connect_to_database=oDataSource.GetConnection("","")
End Function

'[ Function2 ]
Function capitalize(iName As String) As String
Dim wordStart As String
Dim wordEnd As String
	wordStart = UCase(Mid(iName,1,1))
	wordEnd = LCase(Mid(iName,2))
	capitalize = wordStart & wordEnd
End Function

BQ-2)[Base-HSQLDB]任意のtableから指定した項目(title,author,publish)を抽出する。

Sub oBase_Query2
Dim db As Object
Dim oBase as String
	oBase ="oBase_test"
	db = connect_to_database(oBase)
	simple_query(db)
	disconnect_from_database(db)
End Sub

'[ Sub Routine1 ]
Sub disconnect_from_database ( db as Object)
	db.close
	db.dispose()
End Sub

'[ Sub Routine2 ]
Sub simple_query(db as Object)
	Dim oSql As String
	Dim i As Integer
	Dim oRowSet As Object
	Dim oResult As String
		oSql = "SELECT " & " " & "title,author,published" & " " & "FROM" & " " & "table1"
		oRowSet = createUnoService("com.sun.star.sdb.RowSet")
		With oRowSet
			.activeConnection = db
			.Command = oSql
			.execute
		End With
		While oRowSet.Next
			oResult = oResult & oRowset.getString(1)  & " " _
		 		& oRowset.getString(2)  & " " _
		 		& oRowset.getString(3)  & " " _
		 		&chr(13)
		wend
	msgbox oResult,,"Macro_Query"
End Sub

'[ Function1 ]
Function connect_to_database(dbName as String) as Object 
	Dim dbContext As Object
	Dim oDataSource As Object
		dbContext =createUnoService("com.sun.star.sdb.DatabaseContext")
		oDataSource= dbContext.getByName(dbName)
		connect_to_database=oDataSource.GetConnection("","")
End Function

BQ-3)[Base-HSQLDB]任意のtableから出版社(publish)と書名(title)を指定して抽出

'Option Base1
Sub oBase_Query3
Dim db As Object
Dim oBase as String
	oBase ="oBase_test"
	db = connect_to_database(oBase)
	simple_query(db)
	disconnect_from_database(db)
End Sub

'[ Sub Routine1 ]
Sub disconnect_from_database ( db as Object)
	db.close
	db.dispose()
End Sub

'[ Sub Routine2 ]
Sub simple_query(db as Object)
Dim oSql As String
Dim i As Integer
Dim oRowSet As Object
Dim oResult As String
	oSql = "SELECT " & " " & "title,publish,published" & " " & "FROM" & " " & "table1" & " " & "WHERE" & " " & "publish = 'oPublish1' and title = 'test1' ;"
	oRowSet = createUnoService("com.sun.star.sdb.RowSet")
	With oRowSet
		.activeConnection = db
		.Command = oSql
		.execute
	End With
	While oRowSet.Next
		oResult = oResult & oRowset.getString(1)  & " " _
		 & oRowset.getString(2) & " " _
		 & oRowset.getString(3) & " " _
		 & oRowset.getString(4) & " " _
		 &chr(13)
	wend
	msgbox oResult,,"Macro_Query"
End Sub

'[ Function1 ]
Function connect_to_database(dbName as String) as Object 
Dim dbContext As Object
Dim oDataSource As Object
	dbContext =createUnoService("com.sun.star.sdb.DatabaseContext")
	
	oDataSource= dbContext.getByName(dbName)
	connect_to_database=oDataSource.GetConnection("","")
End Function

BQ-)[Base-HSQLDB]Tableの削除

Sub oSQL
	On Error Goto oBad
	'Create New Base Document 
		Dim oDoc as Object
		Dim Dummy()
			oTempName = ConvertToUrl("c:\temp\oBaseMacro3.odb")
			oDoc = StarDesktop.loadComponentFromURL(oTempName, "_default", 0, Dummy())
			oDataSource = oDoc.DataSource
 		'
 		' set to use hsqldb
 			oDataSource.URL = "sdbc:embedded:hsqldb"
 		' store
 		Dim oArgs(0) As new com.sun.star.beans.PropertyValue
			oArgs(0).Name = "Overwrite"
			oArgs(0).Value = true
 			oDoc.StoreAsURL(oTempName,oArgs())			
 		'
 		' Load the Tools library
				If NOT GlobalScope.BasicLibraries.isLibraryLoaded("Tools") Then
					GlobalScope.BasicLibraries.LoadLibrary("Tools")
				End If	
		'
		' Connect DB
			Dim oBaseContent as Object
			Dim oDB as Object
			Dim oCon as Object
				oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  				oDB = oBaseContext.getByName(oTempName)
  				oCon = oDB.getConnection("", "")
  			' 
  			Dim oStmt as Object
  			Dim oSQL1 as String
  			Dim oTableName as String
  				oTableName = "TEST"			' 大文字
  				oStmt = oCon.createStatement()
  			' 既存Tableがあると削除する
  				oSQL1 = "DROP TABLE " & oTableName & " IF EXISTS;  "
				oStmt.execute(oSQL1)
			'
  			oCon.Close()
  			oCon.dispose
  		'
  		' Display
  		msgbox "Success"
  	Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
		'
		oCon.Close()
  		oCon.dispose
End Sub

BQ-)[Base-HSQLDB]Tableの作成


Sub oSQL
	On Error Goto oBad
	'Create New Base Document 
		Dim oDoc as Object
		Dim Dummy()
			oTempName = ConvertToUrl("c:\temp\oBaseMacro3.odb")
			oDoc = StarDesktop.loadComponentFromURL(oTempName, "_default", 0, Dummy())
			oDataSource = oDoc.DataSource
 		'
 		' set to use hsqldb
 			oDataSource.URL = "sdbc:embedded:hsqldb"
 		' store
 		Dim oArgs(0) As new com.sun.star.beans.PropertyValue
			oArgs(0).Name = "Overwrite"
			oArgs(0).Value = true
 			oDoc.StoreAsURL(oTempName,oArgs())			
 		'
 		' Load the Tools library
				If NOT GlobalScope.BasicLibraries.isLibraryLoaded("Tools") Then
					GlobalScope.BasicLibraries.LoadLibrary("Tools")
				End If	
		'
		' Connect DB
			Dim oBaseContent as Object
			Dim oDB as Object
			Dim oCon as Object
				oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  				oDB = oBaseContext.getByName(oTempName)
  				oCon = oDB.getConnection("", "")
  			' 
  			Dim oStmt as Object
  			Dim oSQL1 as String
  			Dim oSQL2 as String
  			Dim oTableName as String
  				oTableName = "TEST"			' 大文字
  				oStmt = oCon.createStatement()
  			' CREATE TABLE句
  				' 既存Tableがあると削除する
  				oSQL1 = "DROP TABLE " & oTableName & " IF EXISTS;  "
				oStmt.execute(oSQL1)
			'
  				oSQL2 = "CREATE TABLE " & oTableName & "(ID INTEGER IDENTITY, oDate Date, PRIMARY KEY (ID)) "
				oStmt.execute(oSQL2)
			'
  			oCon.Close()
  			oCon.dispose
  		'
  		' Display
  		msgbox "Success"
  	Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
		'
		oCon.Close()
  		oCon.dispose
End Sub

BQ-)[Base-HSQLDB]Table( All Data Type )作成


Sub oSQL
	On Error Goto oBad
	Dim oDoc as Object
	Dim oFlag as Integer
	Dim oTempName as String
		oDoc = ThisComponent
		oTempName = oDoc.getURL()
 		'
		' Connect DB
		Dim oBaseContent as Object
		Dim oDB as Object
		Dim oCon as Object
			oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  			oDB = oBaseContext.getByName(oTempName)
  			oCon = oDB.getConnection("", "")
  			oFlag = 777
  			'
  		' CREATE TABLE句
  		Dim oStmt as Object
  		Dim oTableName as String
  			oTableName = "CR_TB"				' 大文字
  			oStmt = oCon.createStatement()
  		' Delete same name table.
  		Dim oSQL1 as String
  			oSQL1 = "DROP TABLE " & oTableName & " IF EXISTS;  "
			oStmt.execute(oSQL1)
		' Create Table
		Dim oSQL2 as String
			oSQL2 = "CREATE TABLE " & oTableName & "(ID INTEGER IDENTITY, COL01 TINYINT, COL02 SMALLINT, COL03 BIGINT" & _
						", COL04 FLOAT, COL05 DOUBLE, COL06 REAL, COL07 NUMERIC, COL08 DECIMAL, COL09 FLOAT" & _
						", COL10 CHAR(255), COL11 VARCHAR(255), COL12 LONGVARCHAR" & _
						", COL13 DATE, COL14 TIME, COL15 TIMESTAMP" & _
						", COL16 BINARY, COL17 VARBINARY, COL18 LONGVARBINARY" & _
						", COL19 BOOLEAN" & _
						", COL20 OTHER" & _
						", PRIMARY KEY (ID)) "
			oStmt.execute(oSQL2)
  		' Refresh Tb
  		Dim dispatcher as Object
  		Dim oFrame as Object
  			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  			oFrame = oDoc.getCurrentController().getFrame()
  			dispatcher.executeDispatch(oFrame,".uno:DBRefreshTables", "", 0, Array())
  			'
  			oCon.Close()
  			oCon.dispose
  			'
  		' Display
  		msgbox "Success"
  	Exit Sub
	oBad:
		if oFlag = 777 then
			oCon.Close()
  			oCon.dispose
		end if
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

BQ-)[Base-HSQLDB]TableへのData入力


Sub oSQL
	On Error Goto oBad
	'Create New Base Document 
		Dim oDoc
		Dim Dummy()
		Dim oAns
			oDoc = StarDesktop.loadComponentFromURL("private:factory/sdatabase", "_blank", 0, Dummy())
			oDataSource = oDoc.DataSource
 		'
 		' set to use hsqldb
 			oDataSource.URL = "sdbc:embedded:hsqldb"
 			oTempName = ConvertToUrl("c:\temp\oBaseMacroTest.odb")
 			if FileExists(oTempName) then
 				oAns = msgbox("同名fileがあります。削除しますか?", 4, "既存fileの削除確認")
 				if oAns = 6 then
 					Kill(oTempName)
 				Else
 					MsgBox("中断します。")
 					Exit Sub
 				End if 				
 			end if
 			oDoc.StoreAsURL(oTempName,Dummy())			
 		'
 		' Load the Tools library
				If NOT GlobalScope.BasicLibraries.isLibraryLoaded("Tools") Then
					GlobalScope.BasicLibraries.LoadLibrary("Tools")
				End If		
		'
		' Connect DB
			Dim oBaseContent
			Dim oDB
			Dim oCon	
				oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  				oDB = oBaseContext.getByName(oTempName)
  				oCon = oDB.getConnection("", "")
  			' CREATE TABLE句
  			Dim oStmt
  			Dim oSQL as String
  			Dim oTableName as String
  				oTableName = "ADRESS"			' 大文字
  				oStmt = oCon.createStatement()
				oSQL = "CREATE TABLE " & oTableName & "(ID INTEGER IDENTITY,ADRESS varchar(5),TITLE varchar(10),NAME varchar(30), PRIMARY KEY (ID)) "
				oStmt.execute(oSQL)
  			'
  			' INSERT INTO句
  			Dim oSQL2 as String
  			Dim oValue as String
  			Dim i as Integer
  				for i = 1 to 100
  					oValue = "VALUES(" & i & ",'home', 'Test" & i & "', 'New_OOo3')"
  					oSQL2 = "INSERT INTO " & oTableName & "(ID, ADRESS, TITLE, NAME)" & " " & oValue
  					oStmt.executeUpdate(oSQL2)
  				Next i
  				
  			'
  			oCon.Close()
  			oCon.dispose
  		'
  		' Display
  		msgbox "Success"
  	Exit Sub
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

BQ-)[Base-HSQLDB]TableへのData入力2(Date)


Sub oSQL
	On Error Goto oBad
	'Create New Base Document 
		Dim oDoc
		Dim Dummy()
		Dim oAns
			oDoc = StarDesktop.loadComponentFromURL("private:factory/sdatabase", "_blank", 0, Dummy())
			oDataSource = oDoc.DataSource
 		'
 		' set to use hsqldb
 			oDataSource.URL = "sdbc:embedded:hsqldb"
 			oTempName = ConvertToUrl("c:\temp\oBaseMacroTest.odb")
 			if FileExists(oTempName) then
 				oAns = msgbox("同名fileがあります。削除しますか?", 4, "既存fileの削除確認")
 				if oAns = 6 then
 					Kill(oTempName)
 				Else
 					MsgBox("中断します。")
 					Exit Sub
 				End if 				
 			end if
 			oDoc.StoreAsURL(oTempName,Dummy())			
 		'
 		' Load the Tools library
				If NOT GlobalScope.BasicLibraries.isLibraryLoaded("Tools") Then
					GlobalScope.BasicLibraries.LoadLibrary("Tools")
				End If		
		'
		' Connect DB
			Dim oBaseContent
			Dim oDB
			Dim oCon	
				oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  				oDB = oBaseContext.getByName(oTempName)
  				oCon = oDB.getConnection("", "")
  			' CREATE TABLE句
  			Dim oStmt
  			Dim oSQL as String
  			Dim oTableName as String
  				oTableName = "DateTable"			' 大文字
  				oStmt = oCon.createStatement()
				oSQL = "CREATE TABLE " & oTableName & "(ID INTEGER IDENTITY, oDate Date, PRIMARY KEY (ID)) "
				oStmt.execute(oSQL)
			'	
			' INSERT INTO句
  			Dim oSQL2 as String
  			Dim oValue as String
  			Dim i as Integer
  				for i = 1 to 100
  					oValue = "VALUES(" & i & ",'2011-05-05')"							' HSQLDBが受け付けるのはyyyy-mm-ddだけ
  					oSQL2 = "INSERT INTO " & oTableName & "(ID, oDate)" & " " & oValue
  					oStmt.executeUpdate(oSQL2)
  				Next i
  			'
  			oCon.Close()
  			oCon.dispose
  		'
  		' Display
  		msgbox "Success"
  	Exit Sub
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

BQ-)[Base-HSQLDB]Data抽出及びTable作成


Sub oSQL
	On Error Goto oBad
	'Create New Base Document 
		Dim oDoc
		Dim Dummy()
		Dim oAns
			oDoc = StarDesktop.loadComponentFromURL("private:factory/sdatabase", "_blank", 0, Dummy())
			oDataSource = oDoc.DataSource
 		'
 		' set to use hsqldb
 			oDataSource.URL = "sdbc:embedded:hsqldb"
 			oTempName = ConvertToUrl("c:\temp\oBaseMacroTest.odb")
 			if FileExists(oTempName) then
 				oAns = msgbox("同名fileがあります。削除しますか?", 4, "既存fileの削除確認")
 				if oAns = 6 then
 					Kill(oTempName)
 				Else
 					MsgBox("中断します。")
 					Exit Sub
 				End if 				
 			end if
 			oDoc.StoreAsURL(oTempName,Dummy())			
 		'
 		' Load the Tools library
				If NOT GlobalScope.BasicLibraries.isLibraryLoaded("Tools") Then
					GlobalScope.BasicLibraries.LoadLibrary("Tools")
				End If		
		'
		' Connect DB
			Dim oBaseContent
			Dim oDB
			Dim oCon	
				oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  				oDB = oBaseContext.getByName(oTempName)
  				oCon = oDB.getConnection("", "")
  			' CREATE TABLE句
  			Dim oStmt
  			Dim oSQL as String
  			Dim oTableName as String
  				oTableName = "ADRESS"			' 大文字
  				oStmt = oCon.createStatement()
				oSQL = "CREATE TABLE " & oTableName & "(ID INTEGER IDENTITY,ADRESS varchar(5),TITLE varchar(10),NAME varchar(30), PRIMARY KEY (ID)) "
				oStmt.execute(oSQL)
  			'
  			' INSERT INTO句
  			Dim oSQL2 as String
  			Dim oValue as String
  			Dim i as Integer
  				for i = 1 to 100
  					oValue = "VALUES(" & i & ",'home', 'Test" & i & "', 'New_OOo3')"
  					oSQL2 = "INSERT INTO " & oTableName & "(ID, ADRESS, TITLE, NAME)" & " " & oValue
  					oStmt.executeUpdate(oSQL2)
  				Next i
  			'
  			' SELECT句
  			Dim oSQL3 as String
  			Dim oTableName2 as String
  				oTableName2 = "SELECT_ADRESS"
  				oSQL3 = "SELECT * INTO " & oTableName2 & " FROM " & oTableName
  				oStmt.execute(oSQL3)
  			'
  			oCon.Close()
  			oCon.dispose
  		'
  		' Display
  		msgbox "Success"
  	Exit Sub
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

BQ-)[Base-HSQLDB]Fieldの選択抽出


Sub oSQL
	On Error Goto oBad
	'Create New Base Document 
		Dim oDoc
		Dim Dummy()
		Dim oAns
			oDoc = StarDesktop.loadComponentFromURL("private:factory/sdatabase", "_blank", 0, Dummy())
			oDataSource = oDoc.DataSource
 		'
 		' set to use hsqldb
 			oDataSource.URL = "sdbc:embedded:hsqldb"
 			oTempName = ConvertToUrl("c:\temp\oBaseMacroTest.odb")
 			if FileExists(oTempName) then
 				oAns = msgbox("同名fileがあります。削除しますか?", 4, "既存fileの削除確認")
 				if oAns = 6 then
 					Kill(oTempName)
 				Else
 					MsgBox("中断します。")
 					Exit Sub
 				End if 				
 			end if
 			oDoc.StoreAsURL(oTempName,Dummy())			
 		'
 		' Load the Tools library
				If NOT GlobalScope.BasicLibraries.isLibraryLoaded("Tools") Then
					GlobalScope.BasicLibraries.LoadLibrary("Tools")
				End If		
		'
		' Connect DB
			Dim oBaseContent
			Dim oDB
			Dim oCon	
				oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  				oDB = oBaseContext.getByName(oTempName)
  				oCon = oDB.getConnection("", "")
  			' CREATE TABLE句
  			Dim oStmt
  			Dim oSQL as String
  			Dim oTableName as String
  				oTableName = "ADRESS"			' 大文字
  				oStmt = oCon.createStatement()
				oSQL = "CREATE TABLE " & oTableName & "(ID INTEGER IDENTITY,ADRESS varchar(5),TITLE varchar(10),NAME varchar(30), PRIMARY KEY (ID)) "
				oStmt.execute(oSQL)
  			'
  			' INSERT INTO句
  			Dim oSQL2 as String
  			Dim oValue as String
  			Dim i as Integer
  				for i = 1 to 100
  					oValue = "VALUES(" & i & ",'home', 'Test" & i & "', 'New_OOo3')"
  					oSQL2 = "INSERT INTO " & oTableName & "(ID, ADRESS, TITLE, NAME)" & " " & oValue
  					oStmt.executeUpdate(oSQL2)
  				Next i
  			'
  			' SELECT句
  			Dim oSQL3 as String
  			Dim oTableName2 as String
  				oTableName2 = "SELECT_ADRESS"
  				oSQL3 = "SELECT TITLE, NAME INTO " & oTableName2 & " FROM " & oTableName
  				oStmt.execute(oSQL3)
  			'
  			oCon.Close()
  			oCon.dispose
  		'
  		' Display
  		msgbox "Success"
  	Exit Sub
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

BQ-)[Base-HSQLDB]条件選択抽出1


Sub oSQL
	On Error Goto oBad
	'Create New Base Document 
		Dim oDoc
		Dim Dummy()
		Dim oAns
			oDoc = StarDesktop.loadComponentFromURL("private:factory/sdatabase", "_blank", 0, Dummy())
			oDataSource = oDoc.DataSource
 		'
 		' set to use hsqldb
 			oDataSource.URL = "sdbc:embedded:hsqldb"
 			oTempName = ConvertToUrl("c:\temp\oBaseMacroTest.odb")
 			if FileExists(oTempName) then
 				oAns = msgbox("同名fileがあります。削除しますか?", 4, "既存fileの削除確認")
 				if oAns = 6 then
 					Kill(oTempName)
 				Else
 					MsgBox("中断します。")
 					Exit Sub
 				End if 				
 			end if
 			oDoc.StoreAsURL(oTempName,Dummy())			
 		'
 		' Load the Tools library
				If NOT GlobalScope.BasicLibraries.isLibraryLoaded("Tools") Then
					GlobalScope.BasicLibraries.LoadLibrary("Tools")
				End If		
		'
		' Connect DB
			Dim oBaseContent
			Dim oDB
			Dim oCon	
				oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  				oDB = oBaseContext.getByName(oTempName)
  				oCon = oDB.getConnection("", "")
  			' CREATE TABLE句
  			Dim oStmt
  			Dim oSQL as String
  			Dim oTableName as String
  				oTableName = "ADRESS"			' 大文字
  				oStmt = oCon.createStatement()
				oSQL = "CREATE TABLE " & oTableName & "(ID INTEGER IDENTITY,ADRESS varchar(20),TITLE varchar(20),NAME varchar(30), PRIMARY KEY (ID)) "
				oStmt.execute(oSQL)
  			'
  			' INSERT INTO句
  			Dim oSQL2 as String
  			Dim oValue as String
  			Dim i as Integer
  				for i = 1 to 100
  					oValue = "VALUES(" & i & ",'home" & i & "', 'Test" & i & "', 'New_OOo3')"
  					oSQL2 = "INSERT INTO " & oTableName & "(ID, ADRESS, TITLE, NAME)" & " " & oValue
  					oStmt.executeUpdate(oSQL2)
  				Next i
  			'
  			' WHERE句
  			Dim oWhere as String
  				oWhere = " WHERE  ADRESS='home3' and TITLE='Test3'"
  			' SELECT句
  			Dim oSQL3 as String
  			Dim oTableName2 as String
  				oTableName2 = "SELECT_ADRESS"
  				oSQL3 = "SELECT * INTO " & oTableName2 & " FROM " & oTableName & oWhere
  				oStmt.execute(oSQL3)
  			'
  			oCon.Close()
  			oCon.dispose
  		'
  		' Display
  		msgbox "Success"
  	Exit Sub
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

BQ-)[Base-HSQLDB]条件選択抽出2


Sub oSQL
	On Error Goto oBad
	'Create New Base Document 
		Dim oDoc
		Dim Dummy()
		Dim oAns
			oDoc = StarDesktop.loadComponentFromURL("private:factory/sdatabase", "_blank", 0, Dummy())
			oDataSource = oDoc.DataSource
 		'
 		' set to use hsqldb
 			oDataSource.URL = "sdbc:embedded:hsqldb"
 			oTempName = ConvertToUrl("c:\temp\oBaseMacroTest.odb")
 			if FileExists(oTempName) then
 				oAns = msgbox("同名fileがあります。削除しますか?", 4, "既存fileの削除確認")
 				if oAns = 6 then
 					Kill(oTempName)
 				Else
 					MsgBox("中断します。")
 					Exit Sub
 				End if 				
 			end if
 			oDoc.StoreAsURL(oTempName,Dummy())			
 		'
 		' Load the Tools library
				If NOT GlobalScope.BasicLibraries.isLibraryLoaded("Tools") Then
					GlobalScope.BasicLibraries.LoadLibrary("Tools")
				End If		
		'
		' Connect DB
			Dim oBaseContent
			Dim oDB
			Dim oCon	
				oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  				oDB = oBaseContext.getByName(oTempName)
  				oCon = oDB.getConnection("", "")
  			' CREATE TABLE句
  			Dim oStmt
  			Dim oSQL as String
  			Dim oTableName as String
  				oTableName = "ADRESS"			' 大文字
  				oStmt = oCon.createStatement()
				oSQL = "CREATE TABLE " & oTableName & "(ID INTEGER IDENTITY,ADRESS varchar(20),TITLE varchar(20),NAME varchar(30), PRIMARY KEY (ID)) "
				oStmt.execute(oSQL)
  			'
  			' INSERT INTO句
  			Dim oSQL2 as String
  			Dim oValue as String
  			Dim i as Integer
  				for i = 1 to 100
  					oValue = "VALUES(" & i & ",'home" & i & "', 'Test" & i & "', 'New_OOo3" & "_" & i & "')"
  					oSQL2 = "INSERT INTO " & oTableName & "(ID, ADRESS, TITLE, NAME)" & " " & oValue
  					oStmt.executeUpdate(oSQL2)
  				Next i
  			'
  			' WHERE句
  			Dim oWhere as String
  				oWhere = " WHERE ( (" & oTableName & ".ADRESS = 'home3' AND " & oTableName & ".TITLE = 'Test3') OR (" & oTableName & ".ID = 10 AND " & oTableName & ".NAME = 'New_OOo3_10' ))"
  			' SELECT句
  			Dim oSQL3 as String
  			Dim oTableName2 as String
  				oTableName2 = "SELECT_ADRESS"
  				oSQL3 = "SELECT * INTO " & oTableName2 & " FROM " & oTableName & oWhere
  				oStmt.execute(oSQL3)
  			'
  			oCon.Close()
  			oCon.dispose
  		'
  		' Display
  		msgbox "Success"
  	Exit Sub
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

BQ-)[Base-HSQLDB]あいまい条件選択抽出


Sub oSQL
	On Error Goto oBad
	'Create New Base Document 
		Dim oDoc
		Dim Dummy()
		Dim oAns
			oDoc = StarDesktop.loadComponentFromURL("private:factory/sdatabase", "_blank", 0, Dummy())
			oDataSource = oDoc.DataSource
 		'
 		' set to use hsqldb
 			oDataSource.URL = "sdbc:embedded:hsqldb"
 			oTempName = ConvertToUrl("c:\temp\oBaseMacroTest.odb")
 			if FileExists(oTempName) then
 				oAns = msgbox("同名fileがあります。削除しますか?", 4, "既存fileの削除確認")
 				if oAns = 6 then
 					Kill(oTempName)
 				Else
 					MsgBox("中断します。")
 					Exit Sub
 				End if 				
 			end if
 			oDoc.StoreAsURL(oTempName,Dummy())			
 		'
 		' Load the Tools library
				If NOT GlobalScope.BasicLibraries.isLibraryLoaded("Tools") Then
					GlobalScope.BasicLibraries.LoadLibrary("Tools")
				End If		
		'
		' Connect DB
			Dim oBaseContent
			Dim oDB
			Dim oCon	
				oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  				oDB = oBaseContext.getByName(oTempName)
  				oCon = oDB.getConnection("", "")
  			' CREATE TABLE句
  			Dim oStmt
  			Dim oSQL as String
  			Dim oTableName as String
  				oTableName = "ADRESS"			' 大文字
  				oStmt = oCon.createStatement()
				oSQL = "CREATE TABLE " & oTableName & "(ID INTEGER IDENTITY,ADRESS varchar(20),TITLE varchar(20),NAME varchar(30), PRIMARY KEY (ID)) "
				oStmt.execute(oSQL)
  			'
  			' INSERT INTO句
  			Dim oSQL2 as String
  			Dim oValue as String
  			Dim i as Integer
  				for i = 1 to 100
  					oValue = "VALUES(" & i & ",'home" & i & "', 'Test" & i & "', 'New_OOo3" & "_" & i & "')"
  					oSQL2 = "INSERT INTO " & oTableName & "(ID, ADRESS, TITLE, NAME)" & " " & oValue
  					oStmt.executeUpdate(oSQL2)
  				Next i
  			'
  			' WHERE句
  			Dim oWhere as String
  				oWhere = " WHERE ( (" & oTableName & ".ADRESS Like 'home%' AND " & oTableName & ".TITLE Like '%10') OR (" & oTableName & ".ID=30 AND " & oTableName & ".NAME Like '%OOo3_%' ))"
  			' SELECT句
  			Dim oSQL3 as String
  			Dim oTableName2 as String
  				oTableName2 = "SELECT_ADRESS"
  				oSQL3 = "SELECT * INTO " & oTableName2 & " FROM " & oTableName & oWhere
  				oStmt.execute(oSQL3)
  			'
  			oCon.Close()
  			oCon.dispose
  		'
  		' Display
  		msgbox "Success"
  	Exit Sub
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

BQ-)[Base-HSQLDB]既存TableにFieldを追加


Sub oSQL
	'Create New Base Document 
		Dim oDoc
		Dim Dummy()
		Dim oAns
			oDoc = StarDesktop.loadComponentFromURL("private:factory/sdatabase", "_blank", 0, Dummy())
			oDataSource = oDoc.DataSource
		'
		' set to use hsqldb
			oDataSource.URL = "sdbc:embedded:hsqldb"
			oTempName = ConvertToUrl("c:\temp\oBaseMacroTest.odb")
			if FileExists(oTempName) then
				oAns = msgbox("同名fileがあります。削除しますか?", 4, "既存fileの削除確認")
				if oAns = 6 then
					Kill(oTempName)
				Else
					MsgBox("中断します。")
					Exit Sub
				End if 				
			end if
			oDoc.StoreAsURL(oTempName,Dummy())			
		'
		' Load the Tools library
				If NOT GlobalScope.BasicLibraries.isLibraryLoaded("Tools") Then
					GlobalScope.BasicLibraries.LoadLibrary("Tools")
				End If		
		'
		' Connect DB
			Dim oBaseContent
			Dim oDB
			Dim oCon	
				oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
 				oDB = oBaseContext.getByName(oTempName)
 				oCon = oDB.getConnection("", "")
 			' CREATE TABLE句
 			Dim oStmt
 			Dim oSQL as String
 			Dim oTableName as String
 				oTableName = "ADRESS"			' 大文字
 				oStmt = oCon.createStatement()
				oSQL = "CREATE TABLE " & oTableName & "(ID INTEGER IDENTITY,ADRESS varchar(20),TITLE varchar(20),NAME varchar(30), PRIMARY KEY (ID)) "
				oStmt.execute(oSQL)
 			'
 			' ALTER句
 			Dim oAlart as String
 				for i = 1 to 5
 					oAlter ="ALTER TABLE " & oTableName & " ADD ADDFIELD" & i & " VARCHAR(30)"
 					oStmt.executeUpdate(oAlter)
 				next i
 			'
 			oCon.Close()
 			oCon.dispose
 		'
 		' Display
 		msgbox "Success"
End Sub

BQ-)[Base-HSQLDB]JOIN結合


Sub oSQL
	'Create New Base Document 
		Dim oDoc
		Dim Dummy()
		Dim oAns
			oDoc = StarDesktop.loadComponentFromURL("private:factory/sdatabase", "_blank", 0, Dummy())
			oDataSource = oDoc.DataSource
		'
		' set to use hsqldb
			oDataSource.URL = "sdbc:embedded:hsqldb"
			oTempName = ConvertToUrl("c:\temp\oBaseMacroTest.odb")
			if FileExists(oTempName) then
				oAns = msgbox("同名fileがあります。削除しますか?", 4, "既存fileの削除確認")
				if oAns = 6 then
					Kill(oTempName)
				Else
					MsgBox("中断します。")
					Exit Sub
				End if 				
			end if
			oDoc.StoreAsURL(oTempName,Dummy())			
		'
		' Load the Tools library
				If NOT GlobalScope.BasicLibraries.isLibraryLoaded("Tools") Then
					GlobalScope.BasicLibraries.LoadLibrary("Tools")
				End If		
		'
		' Connect DB
			Dim oBaseContent
			Dim oDB
			Dim oCon	
				oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
 				oDB = oBaseContext.getByName(oTempName)
 				oCon = oDB.getConnection("", "")
 			' CREATE TABLE句
 			Dim oStmt
 				oStmt = oCon.createStatement()
 			' First Table
 			Dim oSQL11 as String
 			Dim oTableName1 as String
 				oTableName1 = "ADRESS"			' 大文字
				oSQL11 = "CREATE TABLE " & oTableName1 & "(ID INTEGER IDENTITY,ADRESS varchar(20),TITLE varchar(20),NAME varchar(30), PRIMARY KEY (ID)) "
				oStmt.execute(oSQL11)
 			'
 			' INSERT INTO句
  			Dim oSQL12 as String
  			Dim oValue1 as String
  			Dim i as Integer
  				for i = 1 to 100
  					oValue1 = "VALUES(" & i & ",'home" & i & "', 'Test" & i & "', 'New_OOo3" & "_" & i & "')"
  					oSQL12 = "INSERT INTO " & oTableName1 & "(ID, ADRESS, TITLE, NAME)" & " " & oValue1
  					oStmt.executeUpdate(oSQL12)
  				Next i
  			'
 			' Seconds Table
 			Dim oStmt2
 				oStmt2 = oCon.createStatement()
 			Dim oSQL21 as String
 			Dim oTableName2 as String
 				oTableName2 = "TEL"			' 大文字
				oSQL21 = "CREATE TABLE " & oTableName2 & "(ID INTEGER IDENTITY,NAME varchar(30),TEL varchar(30)) "
				oStmt2.execute(oSQL21)
 			'
 			' INSERT INTO句
  			Dim oSQL22 as String
  			Dim oValue2 as String
  			Dim oTel, oTail as String
  				for i = 1 to 100
  					If i < 10 then
  						oTail = "000" & i
  					else
  						If i < 100 then
  							oTail = "00" & i
  						else
  							oTail = "0" & i
  						End If
  					End If
  					oTel = "090-1234-" & oTail
  					oValue2 = "VALUES(" & i & ", 'New_OOo3" & "_" & i & "','" & oTel & "')"
  					oSQL22 = "INSERT INTO " & oTableName2 & "(ID, NAME, TEL)" & " " & oValue2
  					oStmt2.executeUpdate(oSQL22)
  				Next i
 			'
 			' JOIN
 			Dim oStm3 as String
 				oStmt3 = oCon.createStatement()
 			Dim oTableJoin as String
 				oTableJoin = "JOIN_TABLE"
 			' SELECT句
 			Dim oSelJoin as String
 				oSelJoin = "SELECT " & oTableName1 & ".ADRESS, " & oTableName1 & ".NAME, " & oTableName2 & ".TEL"
 			' FROM句
 			Dim oFromJoin as String
 				oFromJoin = " FROM " & oTableName1 & " LEFT JOIN " & oTableName2 & " ON " & oTableName1 & ".NAME = " & oTableName2 & ".NAME"
 			' SQL句
 			Dim oSQLJoin as String
 				oSQLJoin = oSelJoin & " INTO " & oTableJoin & oFromJoin
 			' SQL実行
 			oStmt3.execute(oSQLJoin)
 			'
 			oCon.Close()
 			oCon.dispose
 		'
 		' Display
 		msgbox "Success"
End Sub

BQ-)[Base-HSQLDB]連番Columnを追加


' 連番(0から始まります。)はPrimary Keyにする必要があります。
Sub oSQL
	On Error Goto oBad
	'Create New Base Document 
		Dim oDoc
		Dim Dummy()
		Dim oAns
			oDoc = StarDesktop.loadComponentFromURL("private:factory/sdatabase", "_blank", 0, Dummy())
			oDataSource = oDoc.DataSource
 		'
 		' set to use hsqldb
 			oDataSource.URL = "sdbc:embedded:hsqldb"
 			oTempName = ConvertToUrl("c:\temp\oBaseMacroTest.odb")
 			if FileExists(oTempName) then
 				oAns = msgbox("同名fileがあります。削除しますか?", 4, "既存fileの削除確認")
 				if oAns = 6 then
 					Kill(oTempName)
 				Else
 					MsgBox("中断します。")
 					Exit Sub
 				End if 				
 			end if
 			oDoc.StoreAsURL(oTempName,Dummy())			
 		'
 		' Load the Tools library
				If NOT GlobalScope.BasicLibraries.isLibraryLoaded("Tools") Then
					GlobalScope.BasicLibraries.LoadLibrary("Tools")
				End If		
		'
		' Connect DB
			Dim oBaseContent
			Dim oDB
			Dim oCon	
				oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  				oDB = oBaseContext.getByName(oTempName)
  				oCon = oDB.getConnection("", "")
  			' CREATE TABLE句
  			Dim oStmt
  			Dim oSQL as String
  			Dim oTableName as String
  				oTableName = "ADRESS"			' 大文字
  				oStmt = oCon.createStatement()
				oSQL = "CREATE TABLE " & oTableName & "(ADRESS varchar(5),TITLE varchar(10),NAME varchar(30)) "
				oStmt.execute(oSQL)
  			'
  			' INSERT INTO句
  			Dim oSQL2 as String
  			Dim oValue as String
  			Dim i as Integer
  				for i = 1 to 100
  					oValue = "VALUES('home', 'Test" & i & "', 'New_OOo3')"
  					oSQL2 = "INSERT INTO " & oTableName & "(ADRESS, TITLE, NAME)" & " " & oValue
  					oStmt.executeUpdate(oSQL2)
  				Next i
			'
  			' ALTER句
  			Dim oALTER as String
  				oAlter ="ALTER TABLE " & oTableName & " ADD NO INTEGER IDENTITY PRIMARY KEY"
  				oStmt.execute(oAlter)	
  			'
  			oCon.Close()
  			oCon.dispose
  		'
  		' Display
  		msgbox "Success"
  	Exit Sub
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

BQ-)[Base-HSQLDB]Field値を用いた計算1


Sub oSQL
	On Error Goto oBad
	'Create New Base Document 
		Dim oDoc
		Dim Dummy()
		Dim oAns
			oDoc = StarDesktop.loadComponentFromURL("private:factory/sdatabase", "_blank", 0, Dummy())
			oDataSource = oDoc.DataSource
 		'
 		' set to use hsqldb
 			oDataSource.URL = "sdbc:embedded:hsqldb"
 			oTempName = ConvertToUrl("c:\temp\oBaseMacroTest.odb")
 			if FileExists(oTempName) then
 				oAns = msgbox("同名fileがあります。削除しますか?", 4, "既存fileの削除確認")
 				if oAns = 6 then
 					Kill(oTempName)
 				Else
 					MsgBox("中断します。")
 					Exit Sub
 				End if 				
 			end if
 			oDoc.StoreAsURL(oTempName,Dummy())			
 		'
 		' Load the Tools library
				If NOT GlobalScope.BasicLibraries.isLibraryLoaded("Tools") Then
					GlobalScope.BasicLibraries.LoadLibrary("Tools")
				End If		
		'
		' Connect DB
			Dim oBaseContent
			Dim oDB
			Dim oCon	
				oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  				oDB = oBaseContext.getByName(oTempName)
  				oCon = oDB.getConnection("", "")
  			' CREATE TABLE句
  			Dim oStmt
  			Dim oSQL as String
  			Dim oTableName as String
  				oTableName = "ADRESS"			' 大文字
  				oStmt = oCon.createStatement()
				oSQL = "CREATE TABLE " & oTableName & "(ID INTEGER IDENTITY,ADRESS varchar(5),TITLE varchar(10),NAME varchar(30), PRIMARY KEY (ID)) "
				oStmt.execute(oSQL)
  			'
  			' INSERT INTO句
  			Dim oSQL2 as String
  			Dim oValue as String
  			Dim i as Integer
  				for i = 1 to 100
  					oValue = "VALUES(" & i & ",'home', 'Test" & i & "', 'New_OOo3')"
  					oSQL2 = "INSERT INTO " & oTableName & "(ID, ADRESS, TITLE, NAME)" & " " & oValue
  					oStmt.executeUpdate(oSQL2)
  				Next i
  			'
  			' SELECT句
  			Dim oSQL3 as String
  			Dim oTableName2 as String
  				oTableName2 = "NEW_ADDR"
  				oSQL3 = "SELECT *,ID + 10 as ID2 INTO " & oTableName2 & " FROM " & oTableName
  				oStmt.execute(oSQL3)
  			'
  			oCon.Close()
  			oCon.dispose
  		'
  		' Display
  		msgbox "Success"
  	Exit Sub
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

BQ-)[Base-HSQLDB]Column数の取得


Sub oColumnCount
	On Error Goto oBad
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("Test")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
  		Dim oSQL as String
  		Dim Result as Object
  		Dim oColNum as Long
   			oStmt = oCon.createStatement()
			oSQL = "SELECT * FROM table1;"		' Table名は大文字/小文字を区別する。
			oResult = oStmt.executeQuery(oSQL)
			oColNum = oResult.getMetaData().ColumnCount
			oDisp = "「table1」のColumn数(列数)は" & Chr$(10) & "  " & oColNum & Chr$(10) & "です。"
			msgbox(oDisp,0,"Column数の取得")
		'
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose
		'
		msgbox "Success"
		Exit Sub
		'
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")		
End Sub

BQ-)[Base-HSQLDB]任意のData( Record )の削除


Sub oSQL
	On Error Goto oBad
	'Create New Base Document 
		Dim oDoc
		Dim Dummy()
		Dim oAns
			oDoc = StarDesktop.loadComponentFromURL("private:factory/sdatabase", "_blank", 0, Dummy())
			oDataSource = oDoc.DataSource
 		'
 		' set to use hsqldb
 			oDataSource.URL = "sdbc:embedded:hsqldb"
 			oTempName = ConvertToUrl("c:\temp\oBaseMacroTest.odb")
 			if FileExists(oTempName) then
 				oAns = msgbox("同名fileがあります。削除しますか?", 4, "既存fileの削除確認")
 				if oAns = 6 then
 					Kill(oTempName)
 				Else
 					MsgBox("中断します。")
 					Exit Sub
 				End if 				
 			end if
 			oDoc.StoreAsURL(oTempName,Dummy())			
 		'
 		' Load the Tools library
				If NOT GlobalScope.BasicLibraries.isLibraryLoaded("Tools") Then
					GlobalScope.BasicLibraries.LoadLibrary("Tools")
				End If		
		'
		' Connect DB
			Dim oBaseContent
			Dim oDB
			Dim oCon	
				oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  				oDB = oBaseContext.getByName(oTempName)
  				oCon = oDB.getConnection("", "")
  			' CREATE TABLE句
  			Dim oStmt
  			Dim oSQL as String
  			Dim oTableName as String
  				oTableName = "ADRESS"			' 大文字
  				oStmt = oCon.createStatement()
				oSQL = "CREATE TABLE " & oTableName & "(ID INTEGER IDENTITY,ADRESS varchar(5),TITLE varchar(10),NAME varchar(30), PRIMARY KEY (ID)) "
				oStmt.execute(oSQL)
  			'
  			' INSERT INTO句
  			Dim oSQL2 as String
  			Dim oValue as String
  			Dim i as Integer
  				for i = 1 to 100
  					oValue = "VALUES(" & i & ",'home', 'Test" & i & "', 'New_OOo3')"
  					oSQL2 = "INSERT INTO " & oTableName & "(ID, ADRESS, TITLE, NAME)" & " " & oValue
  					oStmt.executeUpdate(oSQL2)
  				Next i
  			'
  			' DELETE句
  			Dim oSQL3 as String
  				oSQL3 = "DELETE FROM " & oTableName & " WHERE  ID IN( 31,32,35,37)"
  				oStmt.executeUpdate(oSQL3)	
  			'
  			oCon.Close()
  			oCon.dispose
  		'
  		' Display
  		msgbox "Success"
  	Exit Sub
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

BQ-)[Base-HSQLDB]任意のDataの削除(サブクエリ利用)


Sub oSQL
	On Error Goto oBad
	'Create New Base Document 
		Dim oDoc
		Dim Dummy()
		Dim oAns
			oDoc = StarDesktop.loadComponentFromURL("private:factory/sdatabase", "_blank", 0, Dummy())
			oDataSource = oDoc.DataSource
 		'
 		' set to use hsqldb
 			oDataSource.URL = "sdbc:embedded:hsqldb"
 			oTempName = ConvertToUrl("c:\temp\oBaseMacroTest.odb")
 			if FileExists(oTempName) then
 				oAns = msgbox("同名fileがあります。削除しますか?", 4, "既存fileの削除確認")
 				if oAns = 6 then
 					Kill(oTempName)
 				Else
 					MsgBox("中断します。")
 					Exit Sub
 				End if 				
 			end if
 			oDoc.StoreAsURL(oTempName,Dummy())			
 		'
 		' Load the Tools library
				If NOT GlobalScope.BasicLibraries.isLibraryLoaded("Tools") Then
					GlobalScope.BasicLibraries.LoadLibrary("Tools")
				End If		
		'
		' Connect DB
			Dim oBaseContent
			Dim oDB
			Dim oCon	
				oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  				oDB = oBaseContext.getByName(oTempName)
  				oCon = oDB.getConnection("", "")
  			' CREATE TABLE句
  			Dim oStmt
  			Dim oSQL as String
  			Dim oTableName as String
  				oTableName = "ADRESS"			' 大文字
  				oStmt = oCon.createStatement()
				oSQL = "CREATE TABLE " & oTableName & "(ID INTEGER IDENTITY,ADRESS varchar(5),TITLE varchar(10),NAME varchar(30), PRIMARY KEY (ID)) "
				oStmt.execute(oSQL)
  			'
  			' INSERT INTO句
  			Dim oSQL2 as String
  			Dim oValue as String
  			Dim i as Integer
  				for i = 1 to 100
  					oValue = "VALUES(" & i & ",'home', 'Test" & i & "', 'New_OOo3')"
  					oSQL2 = "INSERT INTO " & oTableName & "(ID, ADRESS, TITLE, NAME)" & " " & oValue
  					oStmt.executeUpdate(oSQL2)
  				Next i
  			'
  			' 任意の別Tableの作成
  			Dim oSQL3 as String
  			Dim oTableName2 as String
  				oTableName2 = "SELECT_ADRESS"
  				oSQL3 = "SELECT ID,NAME INTO " & oTableName2 & " FROM " & oTableName & " WHERE  ID IN( 30,32,34,36,38)"
  				oStmt.execute(oSQL3)
  			'	
  			' DELETE句
  			Dim oSQL4 as String
  				oSQL4 = "DELETE FROM " & oTableName & " WHERE  ID  IN(SELECT ID FROM " & oTableName2 & ")"
  				oStmt.executeUpdate(oSQL4)	
  			'
  			oCon.Close()
  			oCon.dispose
  		'
  		' Display
  		msgbox "Success"
  	Exit Sub
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

BQ-)[Base-HSQLDB]Colunmの追加


Sub oSQL
	On Error Goto oBad
	'Create New Base Document 
		Dim oDoc
		Dim Dummy()
		Dim oAns
			oDoc = StarDesktop.loadComponentFromURL("private:factory/sdatabase", "_blank", 0, Dummy())
			oDataSource = oDoc.DataSource
 		'
 		' set to use hsqldb
 			oDataSource.URL = "sdbc:embedded:hsqldb"
 			oTempName = ConvertToUrl("c:\temp\oBaseMacroTest.odb")
 			if FileExists(oTempName) then
 				oAns = msgbox("同名fileがあります。削除しますか?", 4, "既存fileの削除確認")
 				if oAns = 6 then
 					Kill(oTempName)
 				Else
 					MsgBox("中断します。")
 					Exit Sub
 				End if 				
 			end if
 			oDoc.StoreAsURL(oTempName,Dummy())			
 		'
 		' Load the Tools library
				If NOT GlobalScope.BasicLibraries.isLibraryLoaded("Tools") Then
					GlobalScope.BasicLibraries.LoadLibrary("Tools")
				End If		
		'
		' Connect DB
			Dim oBaseContent
			Dim oDB
			Dim oCon	
				oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  				oDB = oBaseContext.getByName(oTempName)
  				oCon = oDB.getConnection("", "")
  			' CREATE TABLE句
  			Dim oStmt
  			Dim oSQL as String
  			Dim oTableName as String
  				oTableName = "ADRESS"			' 大文字
  				oStmt = oCon.createStatement()
				oSQL = "CREATE TABLE " & oTableName & "(ID INTEGER IDENTITY,ADRESS varchar(5),TITLE varchar(10),NAME varchar(30), PRIMARY KEY (ID)) "
				oStmt.execute(oSQL)
  			'
  			' INSERT INTO句
  			Dim oSQL2 as String
  			Dim oValue as String
  			Dim i as Integer
  				for i = 1 to 100
  					oValue = "VALUES(" & i & ",'home', 'Test" & i & "', 'New_OOo3')"
  					oSQL2 = "INSERT INTO " & oTableName & "(ID, ADRESS, TITLE, NAME)" & " " & oValue
  					oStmt.executeUpdate(oSQL2)
  				Next i
  			'
  			' DROP Column
  			Dim oSQL3 as String
  				oSQL3 = "ALTER TABLE " & oTableName & " ADD NEWCLOUMN varchar(20)"
  				oStmt.executeUpdate(oSQL3) 
  				'
  			oCon.Close()
  			oCon.dispose
  		'
  		' Display
  		msgbox "Success"
  	Exit Sub
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

BQ-)[Base-HSQLDB]Colunmの削除


Sub oSQL
	On Error Goto oBad
	'Create New Base Document 
		Dim oDoc
		Dim Dummy()
		Dim oAns
			oDoc = StarDesktop.loadComponentFromURL("private:factory/sdatabase", "_blank", 0, Dummy())
			oDataSource = oDoc.DataSource
 		'
 		' set to use hsqldb
 			oDataSource.URL = "sdbc:embedded:hsqldb"
 			oTempName = ConvertToUrl("c:\temp\oBaseMacroTest.odb")
 			if FileExists(oTempName) then
 				oAns = msgbox("同名fileがあります。削除しますか?", 4, "既存fileの削除確認")
 				if oAns = 6 then
 					Kill(oTempName)
 				Else
 					MsgBox("中断します。")
 					Exit Sub
 				End if 				
 			end if
 			oDoc.StoreAsURL(oTempName,Dummy())			
 		'
 		' Load the Tools library
				If NOT GlobalScope.BasicLibraries.isLibraryLoaded("Tools") Then
					GlobalScope.BasicLibraries.LoadLibrary("Tools")
				End If		
		'
		' Connect DB
			Dim oBaseContent
			Dim oDB
			Dim oCon	
				oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  				oDB = oBaseContext.getByName(oTempName)
  				oCon = oDB.getConnection("", "")
  			' CREATE TABLE句
  			Dim oStmt
  			Dim oSQL as String
  			Dim oTableName as String
  				oTableName = "ADRESS"			' 大文字
  				oStmt = oCon.createStatement()
				oSQL = "CREATE TABLE " & oTableName & "(ID INTEGER IDENTITY,ADRESS varchar(5),TITLE varchar(10),NAME varchar(30), PRIMARY KEY (ID)) "
				oStmt.execute(oSQL)
  			'
  			' INSERT INTO句
  			Dim oSQL2 as String
  			Dim oValue as String
  			Dim i as Integer
  				for i = 1 to 100
  					oValue = "VALUES(" & i & ",'home', 'Test" & i & "', 'New_OOo3')"
  					oSQL2 = "INSERT INTO " & oTableName & "(ID, ADRESS, TITLE, NAME)" & " " & oValue
  					oStmt.executeUpdate(oSQL2)
  				Next i
  			'
  			' DROP Column
  			Dim oSQL3 as String
  				oSQL3 = "ALTER TABLE " & oTableName & " DROP TITLE"
  				oStmt.executeUpdate(oSQL3) 
  				'
  			oCon.Close()
  			oCon.dispose
  		'
  		' Display
  		msgbox "Success"
  	Exit Sub
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

BQ-)[Base-HSQLDB]Tableをcsv FileとしてExport


Sub oSQL
	On Error Goto oBad
	'Create New Base Document 
		' HSQLDBの設定
	Dim oDoc as Object
	Dim oHsqlDbURL as String
		oDoc = ThisComponent
		oHsqlDbURL = oDoc.getURL()
		'
	' Connect DB
	Dim oBaseContext as Object
	Dim oHsqlDB as Object
	Dim oHsqlCon as Object
	Dim oStmt as Object
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  		oHsqlDB = oBaseContext.getByName(oHsqlDbURL)
  		oHsqlCon = oHsqlDB.getConnection("", "")
		'
		oStmt = oHsqlCon.createStatement()
		'
	' CREATE TABLE句
	Dim oSQL1 as String
	Dim oSQL2 as String
	Dim oHsqlTb as String
  	' 既存Tableがあると削除する
  		oHsqlTb = "TEST"
  		oSQL1 = "DROP TABLE " & oHsqlTb & " IF EXISTS;  "
		oStmt.execute(oSQL1)
		'
  		oSQL2 = "CREATE TABLE " & oHsqlTb & "(NO varchar(10), NAME varchar(50)) "
		oStmt.execute(oSQL2)
		'
  	' INSERT INTO句
  	Dim oSQL3 as String
  	Dim oValue as String
  	Dim i as Long
  		for i = 1 to 100
  			oValue = "VALUES(" & CStr(i) & ",'new_OOo3_" & i & "')"
  			oSQL3 = "INSERT INTO " & oHsqlTb & "(NO, NAME)" & " " & oValue
  			oStmt.executeUpdate(oSQL3)
  		Next i
  		'
  	' Export
  	Dim oCsvFile as String
  	Dim oSQLExpot as String
  		oCsvFile = "ExportTb3"						' Base Fileと同じDirectory( c:\temp )  に出力
  		'
  	' Export
		oSQLExpot = "SELECT * INTO TEXT " & oCsvFile & " FROM " & oHsqlTb 
		oStmt.execute(oSQLExpot)
  		'
  		oHsqlCon.Close()
  		'
  		' Display
  		msgbox "Success"
  	Exit Sub
  	'
	oBad:
		oHsqlCon.Close()
		'
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

BQ-)[Base-HSQLDB]Tableをcsv FileとしてExport( Tab区切り )


Sub oSQL_Export
	On Error Goto oBad
	' ***** [ 現在のBase File にTable作成 ] *****
	Dim oBaseContext as Object
	Dim oUser$
	Dim oPass$
	Dim oFlag as Integer
		oFlag = 0
		oUser$ = ""
		oPass$ = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		'
	' Connect with the DataSource
	Dim oDoc as Object
	Dim oBaseSrc as String
	Dim oDataSource as Object
	Dim oCon as Object
		oDoc = ThisComponent
		oBaseSrc = oDoc.getURL()
		oDataSource = oBaseContext.getByName(oBaseSrc)
		oCon = oDataSource.getConnection(oUser, oPass)
		oFlag = 777
		'
	Dim oStmt
  	Dim oTableName as String
  		oTableName = "ADRESS_TB"			' 大文字
  		oStmt = oCon.createStatement()
  		'
  	' Drop Tb
  	' Delete same name table.
  		Dim oSQL_Drop as String
  			oSQL_Drop = "DROP TABLE " & oTableName & " IF EXISTS;  "
			oStmt.execute(oSQL_Drop)
			'
  	' Create Tb
  	Dim oSQL as String
		oSQL = "CREATE TABLE " & oTableName & "(ID INTEGER IDENTITY,ADRESS varchar(5),TITLE varchar(10),NAME varchar(30), PRIMARY KEY (ID)) "
		oStmt.execute(oSQL)
  		'
  	' INSERT INTO句
  	Dim oSQL2 as String
  	Dim oValue as String
  	Dim i as Integer
  		for i = 1 to 100
  			oValue = "VALUES(" & i & ",'home', 'Test" & i & "', 'New_OOo3')"
  			oSQL2 = "INSERT INTO " & oTableName & "(ID, ADRESS, TITLE, NAME)" & " " & oValue
  			oStmt.executeUpdate(oSQL2)
  		Next i
  	'
  ' Export
  	Dim oCsvFile as String
  	Dim oSQLExpot as String
  		oCsvFile = "EXPORT_TB"						' Base Fileと同じDirectory( c:\temp )  に出力
  		'
  	' Export
  	' Delete same name table.
  	Dim oSQL_Drop02 as String
  		oSQL_Drop02 = "DROP TABLE " & oCsvFile & " IF EXISTS;  "
		oStmt.execute(oSQL_Drop02)
		'
	' Export Text Tb用のTemp Tb 作成
  	Dim oSQL_TmpCSV as String
  		oSQL_TmpCSV = "CREATE TEXT TABLE " & oCsvFile & "(ID INTEGER IDENTITY,ADRESS varchar(5),TITLE varchar(10),NAME varchar(30));"
		oStmt.execute(oSQL_TmpCSV)
		'
	' Local の Text Tb と関連付けて Export
	Dim oSetCSV as String
	Dim oSQLExport as String
  		oSetCSV = "SET TABLE """ & oCsvFile & """ SOURCE """ & oCsvFile & ".csv;fs=\t;encoding='UTF-8'"""
		oSQLExport = "INSERT INTO """ & oCsvFile & """ SELECT * FROM """ & oTableName & """;"
		oStmt.execute(oSetCSV)
		oStmt.execute(oSQLExport)
  		'
  	' Temp Tb の削除
  		oStmt.execute(oSQL_Drop02)
  		'
  		oCon.Close()
  		oCon.dispose
  		'
  		' Display
  		msgbox "Success"
  	Exit Sub
	oBad:
		if oFlag = 777 then
			oCon.Close()
  			oCon.dispose
		end If
		'
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
'
' [ 区切り文字 ]
' , : Comma
' | : 「 | 」
' \semi : semicolon
' \quote : single-quote
' \space : space character
' \apos : apostrophe
' \n : newline - Used as an end anchor (like $ in regular expressions)
' \r : carriage return
' \t : tab
' \\ : backslash
' \u#### : a Unicode character specified in hexadecimal

BQ-)[Base-HSQLDB]csv FileからImport


Sub oSQL_Import
	On Error Goto oBad
	' ***** [ 現在のBase File にTable作成 ] *****
	Dim oBaseContext as Object
	Dim oUser$
	Dim oPass$
	Dim oFlag as Integer
		oFlag = 0
		oUser$ = ""
		oPass$ = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		'
	' Connect with the DataSource
	Dim oDoc as Object
	Dim oBaseSrc as String
	Dim oDataSource as Object
	Dim oCon as Object
		oDoc = ThisComponent
		oBaseSrc = oDoc.getURL()
		oDataSource = oBaseContext.getByName(oBaseSrc)
		oCon = oDataSource.getConnection(oUser, oPass)
		oFlag = 777
		'
	Dim oStmt
  	Dim oTableName as String
  		oTableName = "IMPORT_TB"			' 大文字
  		oStmt = oCon.createStatement()
  		'
  	' Drop Tb
  	' Delete same name table.
  		Dim oSQL_Drop as String
  			oSQL_Drop = "DROP TABLE " & oTableName & " IF EXISTS;  "
			oStmt.execute(oSQL_Drop)
			'
  	' Create Tb
  	Dim oSQL as String
		oSQL = "CREATE TABLE " & oTableName & "(ID INTEGER IDENTITY,ADRESS varchar(5),TITLE varchar(10),NAME varchar(30), PRIMARY KEY (ID)) "
		oStmt.execute(oSQL)
  		'
  	' Import
  	Dim oCsvFile as String
  	Dim oSQLExpot as String
  		oCsvFile = "TEMP_TB"						' Base Fileと同じDirectory( c:\temp )  に出力
  		'
  	' Imprt元のText Tbの有無確認
	Dim oChkTxtFile as String
		oChkTxtFile = "c:\temp\" & oCsvFile & ".csv"
		If NOT FileExists(oChkTxtFile) then
			oDisp = "Import元 Tb " & oChkTxtFile & "がありません"
			msgbox oDisp,0,"Text Tb有無Check"
			oCon.Close()
  			oCon.dispose
  			Exit Sub
		end if
		'
  	' Delete same name table.
  	Dim oSQL_Drop02 as String
  		oSQL_Drop02 = "DROP TABLE " & oCsvFile & " IF EXISTS;  "
		oStmt.execute(oSQL_Drop02)
		'
	' Import Text Tb用のTemp Tb 作成
  	Dim oSQL_TmpCSV as String
  		oSQL_TmpCSV = "CREATE TEXT TABLE " & oCsvFile & "(ID INTEGER IDENTITY,ADRESS varchar(5),TITLE varchar(10),NAME varchar(30));"
		oStmt.execute(oSQL_TmpCSV)
		'
	' Local の Text Tb と関連付けて Import
	Dim oSetCSV as String
	Dim oSQLImprot as String
  		oSetCSV = "SET TABLE """ & oCsvFile & """ SOURCE """ & oCsvFile & ".csv;fs=\t;encoding='UTF-8'"""
		oSQLImprot = "INSERT INTO """ & oTableName & """ SELECT * FROM """ & oCsvFile & """;"
		oStmt.execute(oSetCSV)
		oStmt.execute(oSQLImprot)
  		'
  	' Temp Tb の削除
  		oStmt.execute(oSQL_Drop02)
  		'
  		oCon.Close()
  		oCon.dispose
  		'
  		' Display
  		msgbox "Success"
  	Exit Sub
	oBad:
		if oFlag = 777 then
			oCon.Close()
  			oCon.dispose
		end If
		'
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

BQ-)[Base-HSQLDB]Databaseの最適化

Sub oSQL
	On Error Goto oBad
	' ***** [ 現在のBase File にTable作成 ] *****
	Dim oBaseContext as Object
	Dim oUser$
	Dim oPass$
	Dim oFlag as Integer
		oFlag = 0
		oUser$ = ""
		oPass$ = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		'
	' Connect with the DataSource
	Dim oDoc as Object
	Dim oBaseSrc as String
	Dim oDataSource as Object
	Dim oCon as Object
		oDoc = ThisComponent
		oBaseSrc = oDoc.getURL()
		oDataSource = oBaseContext.getByName(oBaseSrc)
		oCon = oDataSource.getConnection(oUser, oPass)
		oFlag = 777
		'
	' ****** [ Defrag ] ******
	
	Dim oStmt as Object
  	Dim oSQLDefrag as String
  		oStmt = oCon.createStatement()
		oSQLDefrag = "CHECKPOINT DEFRAG"
		oStmt.execute(oSQLDefrag)
  	
	' *********************
	'
	'Unconnect with the Datasource
		oCon.close()
		oCon.dispose
  		'
  	' Display
  		msgbox "Success"
		'
	Exit Sub
	oBad:
		if oFlag = 777 then
			oCon.close()
			oCon.dispose
		end if
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")		
End Sub

BQ-)[Base-HSQLDB]





Firebird : SQL( Query )

BFbd-)[Base-Firebird]Current FileにTable作成


Sub BaseFirbird()
	Dim oDoc as Object, oBaseContext as Object
	Dim oUser$
	Dim oPass$
	Dim oTempName as String
		oDoc = ThisComponent
		oTempName = oDoc.getURL	
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource as Object
		Dim oCon as Object
			oDataSource = oBaseContext.getByName(oTempName)
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt as Object
  		Dim oSQL as String, oTbName as String
  			oTbName = "ADDRESS"
  			oStmt = oCon.createStatement()
			oSQL = "CREATE TABLE " & oTbName & "(ID INT NOT NULL PRIMARY KEY, NAME VARCHAR(20) NOT NULL UNIQUE); "
			oStmt.execute(oSQL)
		' ********** [ 表示 → Tableの更新 ] **********
		Dim dispatcher as Object
  		Dim oFrame as Object
  			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  			oFrame = oDoc.getCurrentController().getFrame()
  			dispatcher.executeDispatch(oFrame,".uno:DBRefreshTables", "", 0, Array())
		' ****************************************
		' Unconnect with the Datasource
		oCon.close()
		oCon.dispose
		msgbox "Success",0,"LO 4.4.1.2"
End Sub
'
' [ Note ]
' Table Name ⇒ ADDRESS, Column ⇒ ID INT型[ Primary ], NAME : VARCHAR(20)[ Null値禁止、Unique値(重複値不可) ]
' Reference Site : FIREBIRD WIKI / CREATE TABLE

BFbd-)[Base-Firebird]上書きTable作成


Sub BaseFirbird()
	Dim oDoc as Object, oBaseContext as Object
	Dim oUser$
	Dim oPass$
	Dim oTempName as String
		oDoc = ThisComponent
		oTempName = oDoc.getURL	
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource as Object
		Dim oCon as Object
			oDataSource = oBaseContext.getByName(oTempName)
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt as Object
  		Dim oSQL as String, oTbName as String
  			oTbName = "RE_ADDR"
  			oStmt = oCon.createStatement()
			oSQL = "RECREATE TABLE " & oTbName & "(ID INT NOT NULL PRIMARY KEY, NAME VARCHAR(20) NOT NULL UNIQUE); "
			oStmt.execute(oSQL)
		' ********** [ 表示 → Tableの更新 ] **********
		Dim dispatcher as Object
  		Dim oFrame as Object
  			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  			oFrame = oDoc.getCurrentController().getFrame()
  			dispatcher.executeDispatch(oFrame,".uno:DBRefreshTables", "", 0, Array())
		' ****************************************
		' Unconnect with the Datasource
		oCon.close()
		oCon.dispose
		msgbox "Success",0,"LO 4.4.1.2"
End Sub
' [ Note ]
' CREATE TABLE では同名Tableを事前に削除する必要があるが、RECREATE TABLE では削除しなくとも同名TABLEが作れる。
' 但し、警告も無く元のTableは削除されるので注意。

BFbd-)[Base-Firebird]Tableの削除


Sub BaseFirbird()
	Dim oDoc as Object, oBaseContext as Object
	Dim oUser$
	Dim oPass$
	Dim oTempName as String
		oDoc = ThisComponent
		oTempName = oDoc.getURL	
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource as Object
		Dim oCon as Object
			oDataSource = oBaseContext.getByName(oTempName)
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt as Object
  		Dim oSQL as String, oTbName as String
  			oTbName = "ADDRESS"
  			oStmt = oCon.createStatement()
  			' Tableが存在すれば削除
  			if ExistsTb( oCon ,oTbName) = True then
  				oSQL = "DROP TABLE " & oTbName & ";"
  				oStmt.execute(oSQL)
  			end if
		' ********** [ 表示 → Tableの更新 ] **********
		Dim dispatcher as Object
  		Dim oFrame as Object
  			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  			oFrame = oDoc.getCurrentController().getFrame()
  			dispatcher.executeDispatch(oFrame,".uno:DBRefreshTables", "", 0, Array())
		' ****************************************
		' Unconnect with the Datasource
		oCon.close()
		oCon.dispose
		msgbox "Success",0,"LO 4.4.1.2"
End Sub
'
Function ExistsTb( oFuncCon as Object ,oFuncTb as String) as Boolean
	Dim oTbNames() as String
	oTbNames = oFuncCon.getTables().getElementNames()
	if UBound(oTbNames) < 0 then
		ExistsTb = False
		Exit Function
	else
		for i = 0 to UBound(oTbNames)
			if oTbNames(i) = oFuncTb then
				ExistsTb = True
				Exit Function
			end if
		next i
		ExistsTb = False
	end if
End Function
'
' [ Note ]
' 事前にTableの有無を調べるSQLについて

' Case 1 : Menu Bar / Tool / SQL → NG : Return 1 regardless of the presence or absence of the table!!
'   SQL ⇒ EXECUTE block as BEGIN if (exists(SELECT 1 FROM RDB$RELATIONS Where RDB$RELATION_NAME = 'ADDRESS')) then execute statement 'DROP TABLE ADDRESS';END

' Case 2 : Mcaro → Error ' oSQL = "EXECUTE block as BEGIN if (exists(SELECT 1 FROM RDB$RELATIONS Where RDB$RELATION_NAME = 'ADDRESS')) then execute statement 'DROP TABLE ADDRESS';END " ' oStmt.execute(oSQL)


BFbd-)[Base-Firebird]TableにDataを入力


Sub BaseFirbird()
	Dim oDoc as Object, oBaseContext as Object
	Dim oUser$
	Dim oPass$
	Dim oTempName as String
		oDoc = ThisComponent
		oTempName = oDoc.getURL	
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource as Object
		Dim oCon as Object
			oDataSource = oBaseContext.getByName(oTempName)
			oCon = oDataSource.getConnection(oUser, oPass)
		' Create Table Clause
		Dim oStmt as Object
  		Dim oSQL as String, oTbName as String
  			oTbName = "IRT_DATA"
  			oStmt = oCon.createStatement()
			oSQL = "RECREATE TABLE " & oTbName & "(ID INT NOT NULL PRIMARY KEY, NAME VARCHAR(20) NOT NULL UNIQUE, COUNTORY VARCHAR(20)); "
			oStmt.execute(oSQL)
		' Insert Into Clause
  		Dim oSQL2 as String
  		Dim oValue as String
  		Dim i as Integer
  			oStmt = oCon.createStatement()		' Firebird ではTable作成後、再度、oStmtの作成が必要
  			for i = 1 to 10
  				oValue = "VALUES (" & i & " , 'Firebird_" & i & "', 'Japan');"
  				oSQL2 = "INSERT INTO " & oTbName & " " & oValue
  				oStmt.executeUpdate(oSQL2)
  			Next i
		' ********** [ 表示 → Tableの更新 ] **********
		Dim dispatcher as Object
  		Dim oFrame as Object
  			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  			oFrame = oDoc.getCurrentController().getFrame()
  			dispatcher.executeDispatch(oFrame,".uno:DBRefreshTables", "", 0, Array())
		' ****************************************
		' Unconnect with the Datasource
		oCon.close()
		oCon.dispose
		msgbox "Success",0,"LO 4.4.1.2"
End Sub

BFbd-)[Base-Firebird]Dataの削除


Sub BaseFirbird()
	Dim oDoc as Object, oBaseContext as Object
	Dim oUser$
	Dim oPass$
	Dim oTempName as String
		oDoc = ThisComponent
		oTempName = oDoc.getURL	
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource as Object
		Dim oCon as Object
			oDataSource = oBaseContext.getByName(oTempName)
			oCon = oDataSource.getConnection(oUser, oPass)
		' Create Table Clause
		Dim oStmt as Object
  		Dim oSQL as String, oTbName as String
  			oTbName = "DEL_DATA"
  			oStmt = oCon.createStatement()
  			' Tableが存在すれば削除
  			if ExistsTb( oCon ,oTbName) = True then
  				oSQL = "DROP TABLE " & oTbName & ";"
  				oStmt.execute(oSQL)
  			end if
  			oStmt = oCon.createStatement()		' ← Table削除後は再度、oStmtの作成が必要
			oSQL = "CREATE TABLE " & oTbName & "(ID INT NOT NULL PRIMARY KEY, NAME VARCHAR(20) NOT NULL UNIQUE, COUNTRY VARCHAR(20)); "
			oStmt.execute(oSQL)
		' Insert Into Clause
  		Dim oValue as String
  		Dim i as Integer
  			oStmt = oCon.createStatement()		' Firebird ではTable作成後、再度、oStmtの作成が必要
  			for i = 1 to 10
  				oValue = "VALUES (" & i & " , 'Firebird_" & i & "', 'Japan');"
  				oSQL = "INSERT INTO " & oTbName & " " & oValue
  				oStmt.executeUpdate(oSQL)
  			Next i
  		' Delete Clause
  			oSQL = "DELETE FROM " & oTbName  & " WHERE MOD(ID, 2)=0;"
  			oStmt.executeUpdate(oSQL)
		' ********** [ 表示 → Tableの更新 ] **********
		Dim dispatcher as Object
  		Dim oFrame as Object
  			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  			oFrame = oDoc.getCurrentController().getFrame()
  			dispatcher.executeDispatch(oFrame,".uno:DBRefreshTables", "", 0, Array())
		' ****************************************
		' Unconnect with the Datasource
		oCon.close()
		oCon.dispose
		msgbox "Success",0,"LO 4.4.1.2"
End Sub
'
Function ExistsTb( oFuncCon as Object ,oFuncTb as String) as Boolean
	Dim oTbNames() as String
	oTbNames = oFuncCon.getTables().getElementNames()
	if UBound(oTbNames) < 0 then
		ExistsTb = False
		Exit Function
	else
		for i = 0 to UBound(oTbNames)
			if oTbNames(i) = oFuncTb then
				ExistsTb = True
				Exit Function
			end if
		next i
		ExistsTb = False
	end if
End Function

BFbd-)[Base-Firebird]Dataを抽出して新規Tableへ入力


Sub BaseFirbird()
	Dim oDoc as Object, oBaseContext as Object
	Dim oUser$
	Dim oPass$
	Dim oTempName as String
		oDoc = ThisComponent
		oTempName = oDoc.getURL	
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource as Object
		Dim oCon as Object
			oDataSource = oBaseContext.getByName(oTempName)
			oCon = oDataSource.getConnection(oUser, oPass)
		' Create Table Clause
		Dim oStmt as Object
  		Dim oSQL as String, oTbName as String
  			oTbName = "DEL_DATA"
  			oStmt = oCon.createStatement()
  			' Tableが存在すれば削除
  			if ExistsTb( oCon ,oTbName) = True then
  				oSQL = "DROP TABLE " & oTbName & ";"
  				oStmt.execute(oSQL)
  			end if
  			oStmt = oCon.createStatement()		' ← Table削除後は再度、oStmtの作成が必要
			oSQL = "CREATE TABLE " & oTbName & "(ID INT NOT NULL PRIMARY KEY, NAME VARCHAR(20) NOT NULL UNIQUE, COUNTRY VARCHAR(20)); "
			oStmt.execute(oSQL)
		' Insert Into Clause
  		Dim oValue as String
  		Dim i as Integer
  			oStmt = oCon.createStatement()		' Firebird ではTable作成後、再度、oStmtの作成が必要
  			for i = 1 to 10
  				oValue = "VALUES (" & i & " , 'Firebird_" & i & "', 'Japan');"
  				oSQL = "INSERT INTO " & oTbName & " " & oValue
  				oStmt.executeUpdate(oSQL)
  			Next i
  		'
  		' New Table and Insert Into
  		Dim oTbName2 as String
  			oTbName2 = "SEL_DATA"
  			if ExistsTb( oCon ,oTbName2) = True then
  				oSQL = "DROP TABLE " & oTbName2 & ";"
  				oStmt.execute(oSQL)
  			end if
  			oStmt = oCon.createStatement()		' ← Table削除後は再度、oStmtの作成が必要
  			oSQL = "CREATE TABLE " & oTbName2 & "(ID INT PRIMARY KEY, NAME VARCHAR(20)); "
			oStmt.execute(oSQL)
			oStmt = oCon.createStatement()		' Firebird ではTable作成後、再度、oStmtの作成が必要
			oSQL = "INSERT INTO  " & oTbName2 & " SELECT ID, NAME FROM " & oTbName & " WHERE ID=5;"
			oStmt.execute(oSQL)
		' ********** [ 表示 → Tableの更新 ] **********
		Dim dispatcher as Object
  		Dim oFrame as Object
  			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  			oFrame = oDoc.getCurrentController().getFrame()
  			dispatcher.executeDispatch(oFrame,".uno:DBRefreshTables", "", 0, Array())
		' ****************************************
		' Unconnect with the Datasource
		oCon.close()
		oCon.dispose
		msgbox "Success",0,"LO 4.4.2.2"
End Sub
'
Function ExistsTb( oFuncCon as Object ,oFuncTb as String) as Boolean
	Dim oTbNames() as String
	oTbNames = oFuncCon.getTables().getElementNames()
	if UBound(oTbNames) < 0 then
		ExistsTb = False
		Exit Function
	else
		for i = 0 to UBound(oTbNames)
			if oTbNames(i) = oFuncTb then
				ExistsTb = True
				Exit Function
			end if
		next i
		ExistsTb = False
	end if
End Function
' [ Note ] 
'Firebird does not support( The Firebird FAQ )
'	↓
' CREATE TABLE t2 AS SELECT * FROM t1;
'    or
' SELECT * FROM t1 INTO t2;

BFbd-)[Base-Firebird]Table List取得

Sub BaseFirbird()
	Dim oDoc as Object, oBaseContext as Object
	Dim oUser$
	Dim oPass$
	Dim oTempName as String
		oDoc = ThisComponent
		oTempName = oDoc.getURL	
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource as Object
		Dim oCon as Object
			oDataSource = oBaseContext.getByName(oTempName)
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt as Object
  		Dim oSQL as String, oDisp as String
  		Dim n as Integer
  			oStmt = oCon.createStatement()
			' Get Table Name using SQL in Firrebird
			oSQL = "SELECT RDB$RELATION_NAME AS TABLE_NAME FROM RDB$RELATIONS WHERE RDB$VIEW_SOURCE IS NULL AND RDB$SYSTEM_FLAG = 0 ORDER BY RDB$RELATION_NAME ASC"
			oResultSet= oStmt.executeQuery(oSQL)
			oDisp = "[ Table List ]"
			n = 1
 			While oResultSet.next()
 				oDisp = oDisp & Chr$(10) & n & ") " & Trim(oResultSet.getString(1))	' ← Trim無しではColomn Size分のSpaceがTable Nameに含まれる
 				n = n + 1
 			Wend
		' Unconnect with the Datasource
		oCon.close()
		oCon.dispose
		msgbox oDisp ,0,"LO 4.4.2.2"
End Sub
'
' [ Reference Site ]
' 1) TagoSuckの独習プログラム日記 たごろぐ / Firebirdでテーブル一覧を得る
' 2) 特定非営利活動法人オーユージー : faq/6/73



BFbd-)[Base-Firebird]特定の行数分取得


Sub BaseFirbird()
	Dim oDoc as Object, oBaseContext as Object
	Dim oUser$
	Dim oPass$
	Dim oTempName as String
		oDoc = ThisComponent
		oTempName = oDoc.getURL	
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource as Object
		Dim oCon as Object
			oDataSource = oBaseContext.getByName(oTempName)
			oCon = oDataSource.getConnection(oUser, oPass)
		' Create Table Clause
		Dim oStmt as Object
  		Dim oSQL as String, oTbName as String
  			oTbName = "BASE_DATA"
  			oStmt = oCon.createStatement()
  			' Tableが存在すれば削除
  			if ExistsTb( oCon ,oTbName) = True then
  				oSQL = "DROP TABLE " & oTbName & ";"
  				oStmt.execute(oSQL)
  			end if
  			oStmt = oCon.createStatement()		' ← Table削除後は再度、oStmtの作成が必要
			oSQL = "CREATE TABLE " & oTbName & "(ID INT NOT NULL PRIMARY KEY, NAME VARCHAR(20) NOT NULL UNIQUE, COUNTRY VARCHAR(20)); "
			oStmt.execute(oSQL)
		' Insert Into Clause
  		Dim oValue as String
  		Dim i as Integer
  			oStmt = oCon.createStatement()		' Firebird ではTable作成後、再度、oStmtの作成が必要
  			for i = 10 to 1 step -1
  				oValue = "VALUES (" & i & " , 'Firebird_" & i & "', 'Japan');"
  				oSQL = "INSERT INTO " & oTbName & " " & oValue
  				oStmt.executeUpdate(oSQL)
  			Next i
  		'
  		' New Table and Insert Into
  		Dim oTbName2 as String
  			oTbName2 = "SEL_DATA"
  			if ExistsTb( oCon ,oTbName2) = True then
  				oSQL = "DROP TABLE " & oTbName2 & ";"
  				oStmt.execute(oSQL)
  			end if
  			oStmt = oCon.createStatement()		' ← Table削除後は再度、oStmtの作成が必要
  			oSQL = "CREATE TABLE " & oTbName2 & "(ID INT NOT NULL PRIMARY KEY, NAME VARCHAR(20) NOT NULL UNIQUE, COUNTRY VARCHAR(20)); "
			oStmt.execute(oSQL)
			oStmt = oCon.createStatement()		' Firebird ではTable作成後、再度、oStmtの作成が必要
			oSQL = "INSERT INTO  " & oTbName2 & " SELECT * FROM " & oTbName & " ORDER BY ID ROWS 4 TO 8;"		' ← IDの順に並べて 4~8行取得
			oStmt.execute(oSQL)
		' ********** [ 表示 → Tableの更新 ] **********
		Dim dispatcher as Object
  		Dim oFrame as Object
  			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  			oFrame = oDoc.getCurrentController().getFrame()
  			dispatcher.executeDispatch(oFrame,".uno:DBRefreshTables", "", 0, Array())
		' ****************************************
		' Unconnect with the Datasource
		oCon.close()
		oCon.dispose
		msgbox "Success",0,"LO 4.4.2.2"
End Sub
'
Function ExistsTb( oFuncCon as Object ,oFuncTb as String) as Boolean
	Dim oTbNames() as String
	oTbNames = oFuncCon.getTables().getElementNames()
	if UBound(oTbNames) < 0 then
		ExistsTb = False
		Exit Function
	else
		for i = 0 to UBound(oTbNames)
			if oTbNames(i) = oFuncTb then
				ExistsTb = True
				Exit Function
			end if
		next i
		ExistsTb = False
	end if
End Function
'
' [ Reference Site ]
' TagoSuckの独習プログラム日記 たごろぐ / FirebirdでLIMIT

BFbd-)[Base-Firebird]





MySQL[Base]

[ Table ]

BMT-)[Base-MySQL]新規Table作成


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
  		Dim oSQL as String
  			oStmt = oCon.createStatement()
			oSQL = "CREATE TABLE ADDRESS(ID INT(3),NAME VARCHAR(5),TITLE VARCHAR(10),PRIMARY KEY (ID)); "
			oStmt.execute(oSQL)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]TableにDataを入力


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
  		Dim oSQL as String
  			oStmt = oCon.createStatement()
			oSQL = "INSERT INTO ADDRESS(ID,NAME,TITLE) VALUE(1,'new_OOo3','MySQL_Base_Test'); "
			oStmt.execute(oSQL)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]Tableに複数のDataを入力


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
  		Dim oSQL as String
  		Dim oValue as String
  			oStmt = oCon.createStatement()
  			oValue = "VALUE(2,'new_OOo3_2','MySQL_Base_Test_2'),(3,'new_OOo3_3','MySQL_Base_Test_3')"
			oSQL = "INSERT INTO ADDRESS(ID,NAME,TITLE) " & oValue & "; "
			oStmt.execute(oSQL)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]TableのDataを全て削除


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
  		Dim oSQL as String
  			oStmt = oCon.createStatement()
			oSQL = "DELETE FROM ADDRESS; "
			oStmt.execute(oSQL)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]TableのDataを全て削除2


Note : Delete Fromとの違いはTableを一度破棄した後に再作成する。
トランザクションがActiveな場合はErrorになる。
Sub oMySQL Dim oBaseContext Dim oUser$ Dim oPass$ oUser = "" oPass = "" oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext") ' Connect with the DataSource Dim oDataSource Dim oCon oDataSource = oBaseContext.getByName("MySQL_local") oCon = oDataSource.getConnection(oUser, oPass) Dim oStmt Dim oSQL as String oStmt = oCon.createStatement() oSQL = "TRUNCATE name_table; " oStmt.execute(oSQL) msgbox "Success" 'Unconnect with the Datasource oCon.close() oCon.dispose End Sub

BMT-)[Base-MySQL]任意のData( Record )を削除


Sub oMySQL
	On Error Goto oBad
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
  		Dim oSQL as String
  			oStmt = oCon.createStatement()
			oSQL = "DELETE FROM ADDRESS WHERE ID IN(2,5,6,9); "
			oStmt.execute(oSQL)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose
	Exit Sub
	'
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")		
End Sub

BMT-)[Base-MySQL]任意のDataの削除(サブクエリ利用)


Sub oMySQL
	On Error Goto oBad
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		' 
		' 抽出して新しいTableを作成
		Dim oStmt
		Dim oNewTable as String
		Dim oField as String
		Dim oFrom as String
  		Dim oSQLTable as String
  			oStmt = oCon.createStatement()
  			oNewTable = "NAME_TABLE"
  			oField = " AS SELECT ID, NAME"
  			oFrom = " FROM ADDRESS WHERE (ID LIKE '2%');"
  			oSQLTable = "CREATE TABLE " & oNewTable & oField & oFrom
  			oStmt.execute(oSQLTable)
		'
		' 新規に抽出・作成したTableを利用してDataを削除
  		Dim oSQL2 as String
			oSQL2 = "DELETE FROM ADDRESS WHERE ID IN(SELECT ID FROM " & oNewTable & "); "
			oStmt.execute(oSQL2)
			'
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose
	Exit Sub
	'
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")		
End Sub

BMT-)[Base-MySQL]CSV FileからData入力


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
  		Dim oSQL as String
  			oStmt = oCon.createStatement()
			oSQL = "LOAD DATA LOCAL INFILE 'C:/Temp/MySQL_CSV.csv' INTO TABLE ADDRESS FIELDS TERMINATED BY ',' LINES TERMINATED BY '\r\n'; "
			oStmt.execute(oSQL)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]Dataを抽出して新規Tableへ入力


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
		Dim oNewTable as String
		Dim oField as String
  		Dim oSQLTable, oSQLSelect as String
  			oStmt = oCon.createStatement()
  			oNewTable = "NAME_TABLE"
  			oField = "(NAME VARCHAR(30));"
  			oSQLTable = "CREATE TABLE " & oNewTable & oField
  			oStmt.execute(oSQLTable)
  			'
			oSQLSelect = "INSERT INTO " & oNewTable & " SELECT NAME FROM ADDRESS; "
			oStmt.execute(oSQLSelect)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]Dataを抽出して新規Table作成


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
		Dim oNewTable as String
		Dim oField as String
		Dim oFrom as String
  		Dim oSQLTable as String
  			oStmt = oCon.createStatement()
  			oNewTable = "NAME_TABLE"
  			oField = " AS SELECT NAME, TITLE"
  			oFrom = " FROM ADDRESS WHERE (NAME LIKE '%20');"
  			oSQLTable = "CREATE TABLE " & oNewTable & oField & oFrom
  			oStmt.execute(oSQLTable)
  			'
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]Tableを削除する


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
  		Dim oSQL as String
  			oStmt = oCon.createStatement()
			oSQL = "DROP TABLE IF EXISTS NAME_TABLE; "
			oStmt.execute(oSQL)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]Columnを最後に追加


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
  		Dim oSQL as String
  			oStmt = oCon.createStatement()
			oSQL = "ALTER TABLE ADDRESS ADD TEL varchar(30); "
			oStmt.execute(oSQL)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]Columnを先頭に追加


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
  		Dim oSQL as String
  			oStmt = oCon.createStatement()
			oSQL = "ALTER TABLE ADDRESS ADD FIRSTCOL varchar(30) FIRST; "
			oStmt.execute(oSQL)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]任意の位置にColumnを追加


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
  		Dim oSQL as String
  			oStmt = oCon.createStatement()
			oSQL = "ALTER TABLE ADDRESS ADD AGE INT AFTER NAME; "
			oStmt.execute(oSQL)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]任意の位置にDefault値を設定してColumnを追加


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
  		Dim oSQL as String
  			oStmt = oCon.createStatement()
			oSQL = "ALTER TABLE ADDRESS ADD 性別 VARCHAR(5) NOT Null Default '男' AFTER AGE; "
			oStmt.execute(oSQL)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]Columnを削除


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
  		Dim oSQL as String
  			oStmt = oCon.createStatement()
			oSQL = "ALTER TABLE ADDRESS DROP COLUMN FIRSTCOL; "
			oStmt.execute(oSQL)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]重複Dataを削除


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
  		Dim oNewTable as String
		Dim oField as String
  		Dim oSQLTable, oSQLSelect as String
  			oStmt = oCon.createStatement()
  			oNewTable = "DISTINCT_TABLE"
  			oField = "(NAME VARCHAR(30), 性別 VARCHAR(5));"
  			oSQLTable = "CREATE TABLE " & oNewTable & oField
  			oStmt.execute(oSQLTable)
  			'
			oSQLSelect = "INSERT INTO " & oNewTable & " SELECT DISTINCT NAME, 性別 FROM ADDRESS; "
			oStmt.execute(oSQLSelect)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]LEFT JOIN結合


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
			' First Table
			Dim oStmt1
  				oStmt1 = oCon.createStatement()
  			Dim oSQL11 as String
 			Dim oTableName1 as String
 				oTableName1 = "ADRESS"			' 大文字
			oSQL11 = "CREATE TABLE " & oTableName1 & "(ID INT(3),ADRESS varchar(20),TITLE varchar(20),NAME varchar(30),PRIMARY KEY (ID)); "
			oStmt1.execute(oSQL11)
				'
 			' INSERT INTO句
  			Dim oSQL12 as String
  			Dim oValue1 as String
  			Dim i as Integer
  				for i = 1 to 100
  					oValue1 = "VALUE(" & i & ",'home" & i & "', 'Test" & i & "', 'New_OOo3" & "_" & i & "');"
  					oSQL12 = "INSERT INTO " & oTableName1 & "(ID, ADRESS, TITLE, NAME)" & " " & oValue1
  					oStmt1.executeUpdate(oSQL12)
  				Next i
  			' Seconds Table
 			Dim oStmt2
 				oStmt2 = oCon.createStatement()
 			Dim oSQL21 as String
 			Dim oTableName2 as String
 				oTableName2 = "TEL"			' 大文字
				oSQL21 = "CREATE TABLE " & oTableName2 & "(ID INT(3),NAME varchar(30),TEL varchar(30)) "
				oStmt2.execute(oSQL21)
			' INSERT INTO句
  			Dim oSQL22 as String
  			Dim oValue2 as String
  			Dim oTel, oTail as String
  				for i = 1 to 100
  					If i < 10 then
  						oTail = "000" & i
  					else
  						If i < 100 then
  							oTail = "00" & i
  						else
  							oTail = "0" & i
  						End If
  					End If
  					oTel = "090-1234-" & oTail
  					oValue2 = "VALUE(" & i & ", 'New_OOo3" & "_" & i & "','" & oTel & "');"
  					oSQL22 = "INSERT INTO " & oTableName2 & "(ID, NAME, TEL)" & " " & oValue2
  					oStmt2.executeUpdate(oSQL22)
  				Next i
  			' JOIN Table
  			 Dim oStmt3
 				oStmt3 = oCon.createStatement()
 			Dim oSQL31 as String
 			Dim oTableName3 as String
 				oTableName3 = "JOIN_TABLE"			' 大文字
				oSQL31 = "CREATE TABLE " & oTableName3 & "(ID INT(3),NAME varchar(30),TEL varchar(30)) "
				oStmt3.execute(oSQL31)
			' SELECT句
 			Dim oSelJoin as String
 				oSelJoin = " SELECT " & oTableName1 & ".ID," & oTableName1 & ".NAME, " & oTableName2 & ".TEL"
 			' FROM句
 			Dim oFromJoin as String
 				oFromJoin = " FROM " & oTableName1 & " LEFT JOIN " & oTableName2 & " ON " & oTableName1 & ".NAME = " & oTableName2 & ".NAME;"
 			' SQL句
 			Dim oSQLJoin as String
 				oSQLJoin = "INSERT INTO " & oTableName3 & oSelJoin & oFromJoin
 			' SQL実行
 			oStmt3.execute(oSQLJoin)
  		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]条件選択抽出1


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
		Dim oNewTable as String
		Dim oField as String
  		Dim oSQLTable, oSQLSelect as String
  		Dim oWhere as String
  			oStmt = oCon.createStatement()
  			oNewTable = "NAME_TABLE"
  			oField = "(ID INT(3),NAME VARCHAR(30),TITLE VARCHAR(30));"
  			oSQLTable = "CREATE TABLE " & oNewTable & oField
  			oStmt.execute(oSQLTable)
  			'
  			oWhere = " WHERE NAME = 'new_OOo3_10' and ID = 10 ORDER BY ID;"
			oSQLSelect = "INSERT INTO " & oNewTable & " SELECT ADDRESS.ID, ADDRESS.NAME, ADDRESS.TITLE FROM ADDRESS" & oWhere
			oStmt.execute(oSQLSelect)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]条件選択抽出2


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
		Dim oNewTable as String
		Dim oField as String
  		Dim oSQLTable, oSQLSelect as String
  		Dim oWhere as String
  			oStmt = oCon.createStatement()
  			oNewTable = "NAME_TABLE"
  			oField = "(ID INT(3),NAME VARCHAR(30),TITLE VARCHAR(30));"
  			oSQLTable = "CREATE TABLE " & oNewTable & oField
  			oStmt.execute(oSQLTable)
  			'
  			oWhere = " WHERE (NAME = 'new_OOo3_10' and ID = 10) or (ID = 20) ORDER BY ID;"
			oSQLSelect = "INSERT INTO " & oNewTable & " SELECT ADDRESS.ID, ADDRESS.NAME, ADDRESS.TITLE FROM ADDRESS" & oWhere
			oStmt.execute(oSQLSelect)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]あいまい条件選択抽出


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
		Dim oNewTable as String
		Dim oField as String
  		Dim oSQLTable, oSQLSelect as String
  		Dim oWhere as String
  			oStmt = oCon.createStatement()
  			oNewTable = "NAME_TABLE"
  			oField = "(ID INT(3),NAME VARCHAR(30),TITLE VARCHAR(30));"
  			oSQLTable = "CREATE TABLE " & oNewTable & oField
  			oStmt.execute(oSQLTable)
  			'
  			oWhere = " WHERE (NAME LIKE '%20') or (TITLE LIKE '%Base_1%') ORDER BY ID;"
			oSQLSelect = "INSERT INTO " & oNewTable & " SELECT ADDRESS.ID, ADDRESS.NAME, ADDRESS.TITLE FROM ADDRESS" & oWhere
			oStmt.execute(oSQLSelect)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]Union結合(重複Record削除)


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
		Dim oNewTable1, oNewTable2 as String
		Dim oField as String
		Dim oFrom1, oFrom2 as String
  		Dim oSQLTable1, oSQLTable2 as String
  			oStmt = oCon.createStatement()
  			oNewTable1 = "NAME_TABLE1"
  			oField = " AS SELECT NAME, TITLE"
  			oFrom1 = " FROM ADDRESS WHERE (NAME LIKE '%2%');"
  			oSQLTable1 = "CREATE TABLE " & oNewTable1 & oField & oFrom1
  			oStmt.execute(oSQLTable1)
  		'
  			oNewTable2 = "NAME_TABLE2"
  			oField = " AS SELECT NAME, TITLE"
  			oFrom2 = " FROM ADDRESS WHERE (NAME LIKE '%20');"
  			oSQLTable2 = "CREATE TABLE " & oNewTable2 & oField & oFrom2
  			oStmt.execute(oSQLTable2)
  		' UNION句
  		Dim oCraeteUnion as String
  		Dim oUnionTable as String
  		Dim oUnionField as String
  		Dim oFromUnion as String
  		Dim oSQLUnion as String
  			oUnionTable = "UnionTable"
  			oUnionField = "(NAME VARCHAR(30), TITLE VARCHAR(30));"
  			oCraeteTable = "CREATE TABLE " & oUnionTable & oUnionField
  			oStmt.execute(oCraeteTable)
  			'
  			oFromUnion = " SELECT NAME, TITLE FROM " & oNewTable1 & " UNION SELECT NAME, TITLE FROM " & oNewTable2 & ";"
  			oSQLUnion = "INSERT INTO " & oUnionTable & oFromUnion
  			oStmt.execute(oSQLUnion)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]Union結合(重複Record削除無し)


Sub oMySQL
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oStmt
		Dim oNewTable1, oNewTable2 as String
		Dim oField as String
		Dim oFrom1, oFrom2 as String
  		Dim oSQLTable1, oSQLTable2 as String
  			oStmt = oCon.createStatement()
  			oNewTable1 = "NAME_TABLE1"
  			oField = " AS SELECT NAME, TITLE"
  			oFrom1 = " FROM ADDRESS WHERE (NAME LIKE '%2%');"
  			oSQLTable1 = "CREATE TABLE " & oNewTable1 & oField & oFrom1
  			oStmt.execute(oSQLTable1)
  		'
  			oNewTable2 = "NAME_TABLE2"
  			oField = " AS SELECT NAME, TITLE"
  			oFrom2 = " FROM ADDRESS WHERE (NAME LIKE '%20');"
  			oSQLTable2 = "CREATE TABLE " & oNewTable2 & oField & oFrom2
  			oStmt.execute(oSQLTable2)
  		' UNION句
  		Dim oCraeteUnion as String
  		Dim oUnionTable as String
  		Dim oUnionField as String
  		Dim oFromUnion as String
  		Dim oSQLUnion as String
  			oUnionTable = "UnionTable"
  			oUnionField = "(NAME VARCHAR(30), TITLE VARCHAR(30));"
  			oCraeteTable = "CREATE TABLE " & oUnionTable & oUnionField
  			oStmt.execute(oCraeteTable)
  			'
  			oFromUnion = " SELECT NAME, TITLE FROM " & oNewTable1 & " UNION ALL SELECT NAME, TITLE FROM " & oNewTable2 & ";"
  			oSQLUnion = "INSERT INTO " & oUnionTable & oFromUnion
  			oStmt.execute(oSQLUnion)
		msgbox "Success"
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose				
End Sub

BMT-)[Base-MySQL]連番Columnを追加


Note : 追加するColumnはPrimary Keyである必要がある。
Sub oMySQL Dim oBaseContext Dim oUser$ Dim oPass$ oUser = "" oPass = "" oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext") ' Connect with the DataSource Dim oDataSource Dim oCon oDataSource = oBaseContext.getByName("MySQL_local") oCon = oDataSource.getConnection(oUser, oPass) Dim oStmt Dim oSQL as String oStmt = oCon.createStatement() oSQL = "ALTER TABLE ADDRESS ADD NO int8 unsigned not null auto_increment primary key; " oStmt.execute(oSQL) msgbox "Success" 'Unconnect with the Datasource oCon.close() oCon.dispose End Sub

BMT-)[Base-MySQL]Table Name取得


Sub oBase_TableName
	Dim db As Object
	Dim oBase as String
		oBase ="MySQL_ooobase"
		db = connect_to_database(oBase)
			omysql(db, oBase)
			disconnect_from_database(db)
End Sub

'[ Sub Routine1 ]
Sub disconnect_from_database ( db as Object)
	db.close
	db.dispose()
End Sub

'[ Sub Routine2 ]
Sub omysql(db as Object, oBName)
	Dim dbTables As Object
	Dim dbTableNames
	Dim opText As String
	Dim oLen
	Dim oDBLen
	Dim oDBName
	Dim oPreDB
	Dim oTableName
		Globalscope.BasicLibraries.LoadLibrary( "MRILib" )
		dbTables=db.getTables
		dbTableNames=dbTables.getElementNames
			oDBName = ""
			oTableName =""
			oPreDB = ""
			oDisp = "Base File Name => " & oBName & ".odb" & Chr$(10) & Chr$(10)
		for i = 0 to UBound(dbTableNames)
		'DB Name と Table Nameの分離
			oLen = Len(dbTableNames(i))
			oDBLen = InStr(1, dbTableNames(i), ".")
			oDBName = Left(dbTableNames(i), oDBLen-1)
			oTableName = Right(dbTableNames(i), oLen-oDBLen)
			If oDBName <> oDBName then
				oDisp = oDisp & "   MySQL Table Name => " & oTableName
			else
				oDisp = oDisp & "MySQL DB Name => " & oDBName & Chr$(10) & _
				"   MySQL Table Name => " & oTableName
			End If
		next i
	msgbox (oDisp, 0, "Base - MySQL")
End Sub

'[ Function1 ]
Function connect_to_database(dbName as String) as Object
	Dim dbContext As Object
	Dim oDataSource As Object
		dbContext =createUnoService("com.sun.star.sdb.DatabaseContext")
		oDataSource= dbContext.getByName(dbName)
		connect_to_database=oDataSource.GetConnection("","")
End Function

BMT-)[Base-MySQL]











MS-ACCESS[Base]

BA-)[Base-MsAccess]MS-ACCESS2003 DataにConnect(*.mdb File)


Sub oMsAccess
	On Error Goto oBad
	Dim oDriveManager
	Dim oCon
	Dim oURL as String
	Dim oAccessFile, oAccessURL as String
		oAccessFile = "c:\temp\ACCESS_SQL2003.mdb"
		'
		oAccessURL = ConvertToUrl(oAccessFile)
		If NOT FileExists(oAccessURL) then
			MsgBox( oAccessFile & " は存在しません", 0, "Caution !!")
			Exit Sub
		End If
		'
		oURL = "sdbc:ado:PROVIDER=Microsoft.Jet.OLEDB.4.0;DATA SOURCE=" & oAccessFile
		'
		oDriverManager = CreateUnoService("com.sun.star.sdbc.DriverManager")
		oCon = oDriverManager.getConnection(oURL)
		'
		oCon.Close
		'
		' Display
		oDisp = "File Name => " & oAccessFile & Chr$(10) & "への接続に成功しました。"
		msgbox oDisp,0,"Base-Access"
  		Exit Sub
  		'
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
		'
		oCon.Close
End Sub

BA-)[Base-MsAccess]MS-ACCESS2007 DataにConnect(*.accdb File)


Sub oMsAccess
	On Error Goto oBad
	Dim oDriveManager
	Dim oCon
	Dim oURL as String
	Dim oAccessFile, oAccessURL as String
		oAccessFile = "c:\temp\ACCESS_SQL.accdb"		' <= MS-Access2007形式
		'
		oAccessURL = ConvertToUrl(oAccessFile)
		If NOT FileExists(oAccessURL) then
			MsgBox( oAccessFile & " は存在しません", 0, "Caution !!")
			Exit Sub
		End If
		'
		oURL = "sdbc:ado:PROVIDER=Microsoft.ACE.OLEDB.12.0;DATA SOURCE=" & oAccessFile
		'
		oDriverManager = CreateUnoService("com.sun.star.sdbc.DriverManager")
		oCon = oDriverManager.getConnection(oURL)
		'
		oCon.Close
		'
		' Display
		oDisp = "File Name => " & oAccessFile & Chr$(10) & "への接続に成功しました。"
		msgbox oDisp,0,"Base-Access"
  		Exit Sub
  		'
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
		'
		oCon.Close
End Sub

BA-)[Base-MsAccess]Table Nameの取得(*.mdb File)


Sub oMsAccess
	On Error Goto oBad
	Dim oDriveManager
	Dim oDriver
	Dim oCon
	Dim oURL as String
	Dim oAccessFile, oAccessURL as String
	Dim oParams(0) as New com.sun.star.beans.PropertyValue
	Dim oAccessTables
	Dim oDisp as String
		'
		oAccessFile = "c:\temp\ACCESS_SQL2003.mdb"
		'
		oAccessURL = ConvertToUrl(oAccessFile)
		If NOT FileExists(oAccessURL) then
			MsgBox( oAccessFile & " は存在しません", 0, "Caution !!")
			Exit Sub
		End If
		'
		oParams(0).Name = ""
		oParams(0).Value = ""
		'
		oURL = "sdbc:ado:PROVIDER=Microsoft.Jet.OLEDB.4.0;DATA SOURCE=" & oAccessFile
		'
		oDriverManager = CreateUnoService("com.sun.star.sdbc.DriverManager")
		'
		oDriver = oDriverManager.getDriverByURL(oURL)
		oAccessTables= oDriver.getDataDefinitionByURL(oURL, oParams()).Tables
		'
		If oAccessTables.Count = 0 then
			oDisp = "File Name => " & oAccessFile & Chr$(10) & "にはTableがありません。"
			msgbox oDisp,0,"Tableがありません"
			Exit Sub
		End If
		'
		Dim oTable as Object
			oDisp = "[ File Name ]" & Chr$(10) & oAccessFile & Chr$(10) & Chr$(10) & "** [ 含まれるTable Name ] **" & Chr$(10)
			for i= 0 to oAccessTables.Count-1
				oTable = oAccessTables.getByIndex(i)
				oDisp = oDisp & i+1 & ")" & oTable.Name & Chr$(10)
			next i
			'
		' Display
		msgbox oDisp,0,"Base-Access"
  		Exit Sub
  		'
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
		'
		oCon.Close
End Sub

BA-)[Base-MsAccess]Table Nameの取得(*.accdb File)


Sub oMsAccess2007
	On Error Goto oBad
	Dim oDriveManager
	Dim oDriver
	Dim oCon
	Dim oURL as String
	Dim oAccessFile, oAccessURL as String
	Dim oParams(0) as New com.sun.star.beans.PropertyValue
	Dim oAccessTables
	Dim oDisp as String
		'
		oAccessFile = "c:\temp\ACCESS_SQL.accdb"
		'
		oAccessURL = ConvertToUrl(oAccessFile)
		If NOT FileExists(oAccessURL) then
			MsgBox( oAccessFile & " は存在しません", 0, "Caution !!")
			Exit Sub
		End If
		'
		oParams(0).Name = ""
		oParams(0).Value = ""
		'
		oURL = "sdbc:ado:PROVIDER=Microsoft.ACE.OLEDB.12.0;DATA SOURCE=" & oAccessFile
		'
		oDriverManager = CreateUnoService("com.sun.star.sdbc.DriverManager")
		'
		oDriver = oDriverManager.getDriverByURL(oURL)
		oAccessTables= oDriver.getDataDefinitionByURL(oURL, oParams()).Tables
		'
		If oAccessTables.Count = 0 then
			oDisp = "File Name => " & oAccessFile & Chr$(10) & "にはTableがありません。"
			msgbox oDisp,0,"Tableがありません"
			Exit Sub
		End If
		'
		Dim oTable as Object
			oDisp = "[ File Name ]" & Chr$(10) & oAccessFile & Chr$(10) & Chr$(10) & "** [ 含まれるTable Name ] **" & Chr$(10)
			for i= 0 to oAccessTables.Count-1
				oTable = oAccessTables.getByIndex(i)
				oDisp = oDisp & i+1 & ")" & oTable.Name & Chr$(10)
			next i
			'
		' Display
		msgbox oDisp,0,"Base-Access"
  		Exit Sub
  		'
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
		'
		oCon.Close
End Sub

BA-)[Base-MsAccess]Tableの行No.の取得(*.mdb File)


Sub oMsAccess
	On Error Goto oBad
	Dim oDriveManager
	Dim oDriver
	Dim oURL as String
	Dim oAccessFile, oAccessURL as String
	Dim oParams(0) as New com.sun.star.beans.PropertyValue
	Dim oAccessTables
	Dim oDisp as String
		'
		oAccessFile = "c:\temp\ACCESS_SQL2003.mdb"
		'
		oAccessURL = ConvertToUrl(oAccessFile)
		If NOT FileExists(oAccessURL) then
			MsgBox( oAccessFile & " は存在しません", 0, "Caution !!")
			Exit Sub
		End If
		'
		oParams(0).Name = ""
		oParams(0).Value = ""
		'
		oURL = "sdbc:ado:PROVIDER=Microsoft.Jet.OLEDB.4.0;DATA SOURCE=" & oAccessFile
		'
		oDriverManager = CreateUnoService("com.sun.star.sdbc.DriverManager")
		
		'
		oDriver = oDriverManager.getDriverByURL(oURL)
		oAccessTables= oDriver.getDataDefinitionByURL(oURL, oParams()).Tables
		'
		Dim oTable as Object
		Dim oTableName as String
			oTable = oAccessTables.getByIndex(0)
  			oTableName = oTable.Name
  			'
  		' Connect
		Dim oCon as Object
		Dim oStmt as Object
			oCon = oDriverManager.getConnection(oURL)
 			oStmt = oCon.createStatement()
 			'
  		' ResultSet		
  		Dim oSQL1 as String
  		Dim oRS as Object
  		Dim oLastRowNo, oFirstRowNo, oPreviousRow, oNextRow as Long
  			'
  			oStmt.ResultSetType = com.sun.star.sdbc.ResultSetType.SCROLL_INSENSITIVE
  			oSQL1 = "SELECT * FROM " & oTableName
  			oRS = oStmt.executeQuery(oSQL1)
  			'
  			oDisp = "File Name : " & oAccessFile & Chr$(10) & "Table Name => " & oTableName & Chr$(10) & Chr$(10)
  			'
  			oRS.Last
  			oLastRowNo = oRS.Row
  			'
  			oRS.Previous
  			oPreviousRow = oRS.Row
  			'
  			oRS.First
  			oFirstRowNo = oRS.Row
  			'
  			oRS.Next
  			oNextRow = oRS.Row
  			'
  		' Close
  			oCon.close
  			'
  			oDisp = oDisp & "最後のRow No => " & oLastRowNo & Chr$(10) & _
  						"前のRow No => " & oPreviousRow & Chr$(10) & _
  						"最初のRow No => " & oFirstRowNo & Chr$(10) & _
  						"次のRow No => " & oNextRow
  		' Display 
  			msgbox oDisp,0,"Tableの行No"
		'
  		Exit Sub
  		'
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
		'
		oCon.Close
End Sub

BA-)[Base-MsAccess]Tableの行No.の取得(*.accdb File)


Sub oMsAccess
	On Error Goto oBad
	Dim oDriveManager
	Dim oDriver
	Dim oURL as String
	Dim oAccessFile, oAccessURL as String
	Dim oParams(0) as New com.sun.star.beans.PropertyValue
	Dim oAccessTables
	Dim oDisp as String
		'
		oAccessFile = "c:\temp\ACCESS_SQL.accdb"
		'
		oAccessURL = ConvertToUrl(oAccessFile)
		If NOT FileExists(oAccessURL) then
			MsgBox( oAccessFile & " は存在しません", 0, "Caution !!")
			Exit Sub
		End If
		'
		oParams(0).Name = ""
		oParams(0).Value = ""
		'
		oURL = "sdbc:ado:PROVIDER=Microsoft.ACE.OLEDB.12.0;DATA SOURCE=" & oAccessFile
		'
		oDriverManager = CreateUnoService("com.sun.star.sdbc.DriverManager")
		
		'
		oDriver = oDriverManager.getDriverByURL(oURL)
		oAccessTables= oDriver.getDataDefinitionByURL(oURL, oParams()).Tables
		'
		Dim oTable as Object
		Dim oTableName as String
			oTable = oAccessTables.getByIndex(0)
  			oTableName = oTable.Name
  			'
  		' Connect
		Dim oCon as Object
		Dim oStmt as Object
			oCon = oDriverManager.getConnection(oURL)
 			oStmt = oCon.createStatement()
 			'
  		' ResultSet		
  		Dim oSQL1 as String
  		Dim oRS as Object
  		Dim oLastRowNo, oFirstRowNo, oPreviousRow, oNextRow as Long
  			'
  			oStmt.ResultSetType = com.sun.star.sdbc.ResultSetType.SCROLL_INSENSITIVE
  			oSQL1 = "SELECT * FROM " & oTableName
  			oRS = oStmt.executeQuery(oSQL1)
  			'
  			oDisp = "File Name : " & oAccessFile & Chr$(10) & "Table Name => " & oTableName & Chr$(10) & Chr$(10)
  			'
  			oRS.Last
  			oLastRowNo = oRS.Row
  			'
  			oRS.Previous
  			oPreviousRow = oRS.Row
  			'
  			oRS.First
  			oFirstRowNo = oRS.Row
  			'
  			oRS.Next
  			oNextRow = oRS.Row
  			'
  		' Close
  			oCon.close
  			'
  			oDisp = oDisp & "最後のRow No => " & oLastRowNo & Chr$(10) & _
  						"前のRow No => " & oPreviousRow & Chr$(10) & _
  						"最初のRow No => " & oFirstRowNo & Chr$(10) & _
  						"次のRow No => " & oNextRow
  		' Display 
  			msgbox oDisp,0,"Tableの行No"
		'
  		Exit Sub
  		'
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
		'
		oCon.Close
End Sub

BA-)[Base-MsAccess]現在のCurosr位置判定(*.mdb File)


Sub oMsAccess
	On Error Goto oBad
	Dim oDriveManager
	Dim oDriver
	Dim oURL as String
	Dim oAccessFile, oAccessURL as String
	Dim oParams(0) as New com.sun.star.beans.PropertyValue
	Dim oAccessTables
	Dim oDisp as String
		'
		oAccessFile = "c:\temp\ACCESS_SQL2003.mdb"
		'
		oAccessURL = ConvertToUrl(oAccessFile)
		If NOT FileExists(oAccessURL) then
			MsgBox( oAccessFile & " は存在しません", 0, "Caution !!")
			Exit Sub
		End If
		'
		oParams(0).Name = ""
		oParams(0).Value = ""
		'
		oURL = "sdbc:ado:PROVIDER=Microsoft.Jet.OLEDB.4.0;DATA SOURCE=" & oAccessFile
		'
		oDriverManager = CreateUnoService("com.sun.star.sdbc.DriverManager")
		
		'
		oDriver = oDriverManager.getDriverByURL(oURL)
		oAccessTables= oDriver.getDataDefinitionByURL(oURL, oParams()).Tables
		'
		Dim oTable as Object
		Dim oTableName as String
			oTable = oAccessTables.getByIndex(0)
  			oTableName = oTable.Name
  			'
  		' Connect
		Dim oCon as Object
		Dim oStmt as Object
			oCon = oDriverManager.getConnection(oURL)
 			oStmt = oCon.createStatement()
 			'
  		' ResultSet		
  		Dim oSQL1 as String
  		Dim oRS as Object
  		Dim oIsBeforeFirst1, oIsAfterLast1, oIsFirst1, oIsLast1 as Boolean
  		Dim oIsBeforeFirst2, oIsAfterLast2, oIsFirst2, oIsLast2 as Boolean
  		Dim oIsBeforeFirst3, oIsAfterLast3, oIsFirst3, oIsLast3 as Boolean
  		Dim oIsBeforeFirst4, oIsAfterLast4, oIsFirst4, oIsLast4 as Boolean
  		Dim oIsBeforeFirst5, oIsAfterLast5, oIsFirst5, oIsLast5 as Boolean
  		Dim oIsBeforeFirst6, oIsAfterLast6, oIsFirst6, oIsLast6 as Boolean
  		Dim oIsBeforeFirst7, oIsAfterLast7, oIsFirst7, oIsLast7 as Boolean
  		Dim oRowNo1, oRowNo2, oRowNo3, oRowNo4, oRowNo5, oRowNo6, oRowNo7 as Integer
  			'
  			oStmt.ResultSetType = com.sun.star.sdbc.ResultSetType.SCROLL_INSENSITIVE
  			oSQL1 = "SELECT * FROM " & oTableName
  			oRS = oStmt.executeQuery(oSQL1)
  			'
  			oDisp = "File :  " & oAccessFile & Chr$(10) & "Table Name => " & oTableName & Chr$(10) & Chr$(10)
  			'
  			oRowNo1 = oRS.getRow()
  			oIsBeforeFirst1 = oRS.isBeforeFirst
  			oIsAfterLast1 = oRS.isAfterLast
  			oIsFirst1 = oRS.isFirst
  			oIsLast1 = oRS.isLast
  			oDisp = oDisp & "  現在のCurorのRow No => " & oRowNo1 & Chr$(10) & _
  						Chr$(9) & "isBeforeFirst => " & oIsBeforeFirst1 & Chr$(9) & "isAfterLast => " & oIsAfterLast1 & Chr$(10) & _
  						Chr$(9) & "isFirst => " & oIsFirst1 & Chr$(9) & "isLast => " & oIsLast1 & Chr$(10) & Chr(10)
  			'
  			oRS.Last
  			oRowNo2 = oRS.getRow()
  			oIsBeforeFirst2 = oRS.isBeforeFirst
  			oIsAfterLast2 = oRS.isAfterLast
  			oIsFirst2 = oRS.isFirst
  			oIsLast2 = oRS.isLast
  			oDisp = oDisp & "  現在のCurorのRow No => " & oRowNo2 & Chr$(10) & _
  						Chr$(9) & "isBeforeFirst => " & oIsBeforeFirst2 & Chr$(9) & "isAfterLast => " & oIsAfterLast2 & Chr$(10) & _
  						Chr$(9) & "isFirst => " & oIsFirst2 & Chr$(9) & "isLast => " & oIsLast2 & Chr$(10) & Chr(10)
  			'
  			oRS.Absolute(5)
  			oRowNo3 = oRS.getRow()
  			oIsBeforeFirst3 = oRS.isBeforeFirst
  			oIsAfterLast3 = oRS.isAfterLast
  			oIsFirst3 = oRS.isFirst
  			oIsLast3 = oRS.isLast
  			oDisp = oDisp & "  現在のCurorのRow No => " & oRowNo3 & Chr$(10) & _
  						Chr$(9) & "isBeforeFirst => " & oIsBeforeFirst3 & Chr$(9) & "isAfterLast => " & oIsAfterLast3 & Chr$(10) & _
  						Chr$(9) & "isFirst => " & oIsFirst3 & Chr$(9) & "isLast => " & oIsLast3 & Chr$(10) & Chr(10)
  			'
  			oRS.Relative(-2)
  			oRowNo4 = oRS.getRow()
  			oIsBeforeFirst4 = oRS.isBeforeFirst
  			oIsAfterLast4 = oRS.isAfterLast
  			oIsFirst4 = oRS.isFirst
  			oIsLast4 = oRS.isLast
  			oDisp = oDisp & "  現在のCurorのRow No => " & oRowNo4 & Chr$(10) & _
  						Chr$(9) & "isBeforeFirst => " & oIsBeforeFirst4 & Chr$(9) & "isAfterLast => " & oIsAfterLast4 & Chr$(10) & _
  						Chr$(9) & "isFirst => " & oIsFirst4 & Chr$(9) & "isLast => " & oIsLast4 & Chr$(10) & Chr(10)
  			'
  			oRS.First
  			oRowNo5 = oRS.getRow()
  			oIsBeforeFirst5 = oRS.isBeforeFirst
  			oIsAfterLast5 = oRS.isAfterLast
  			oIsFirst5 = oRS.isFirst
  			oIsLast5 = oRS.isLast
  			oDisp = oDisp & "  現在のCurorのRow No => " & oRowNo5 & Chr$(10) & _
  						Chr$(9) & "isBeforeFirst => " & oIsBeforeFirst5 & Chr$(9) & "isAfterLast => " & oIsAfterLast5 & Chr$(10) & _
  						Chr$(9) & "isFirst => " & oIsFirst5 & Chr$(9) & "isLast => " & oIsLast5 & Chr$(10) & Chr(10)
  			'
  			oRS.afterLast
  			oRowNo6 = oRS.getRow()
  			oIsBeforeFirst6 = oRS.isBeforeFirst
  			oIsAfterLast6 = oRS.isAfterLast
  			oIsFirst6 = oRS.isFirst
  			oIsLast6 = oRS.isLast
  			oDisp = oDisp & "  現在のCurorのRow No( End of result set ) => " & oRowNo6 & Chr$(10) & _
  						Chr$(9) & "isBeforeFirst => " & oIsBeforeFirst6 & Chr$(9) & "isAfterLast => " & oIsAfterLast6 & Chr$(10) & _
  						Chr$(9) & "isFirst => " & oIsFirst6 & Chr$(9) & "isLast => " & oIsLast6 & Chr$(10) & Chr(10)
  			'
  			oRS.beforeFirst
  			oRowNo7 = oRS.getRow()
  			oIsBeforeFirst7 = oRS.isBeforeFirst
  			oIsAfterLast7 = oRS.isAfterLast
  			oIsFirst7 = oRS.isFirst
  			oIsLast7 = oRS.isLast
  			oDisp = oDisp & "  現在のCurorのRow No( the Front of result set ) => " & oRowNo7 & Chr$(10) & _
  						Chr$(9) & "isBeforeFirst => " & oIsBeforeFirst7 & Chr$(9) & "isAfterLast => " & oIsAfterLast7 & Chr$(10) & _
  						Chr$(9) & "isFirst => " & oIsFirst7 & Chr$(9) & "isLast => " & oIsLast7
  			'
  		' Display 
  			msgbox(oDisp,0,"ResultSet Service")
  			'
  			oCon.Close()
		'
  		Exit Sub
  		'
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
		'
		oCon.Close
End Sub

BA-)[Base-MsAccess]現在のCurosr位置判定(*.accdb File)


Sub oMsAccess
	On Error Goto oBad
	Dim oDriveManager
	Dim oDriver
	Dim oURL as String
	Dim oAccessFile, oAccessURL as String
	Dim oParams(0) as New com.sun.star.beans.PropertyValue
	Dim oAccessTables
	Dim oDisp as String
		'
		oAccessFile = "c:\temp\ACCESS_SQL.accdb"
		'
		oAccessURL = ConvertToUrl(oAccessFile)
		If NOT FileExists(oAccessURL) then
			MsgBox( oAccessFile & " は存在しません", 0, "Caution !!")
			Exit Sub
		End If
		'
		oParams(0).Name = ""
		oParams(0).Value = ""
		'
		oURL = "sdbc:ado:PROVIDER=Microsoft.ACE.OLEDB.12.0;DATA SOURCE=" & oAccessFile
		'
		oDriverManager = CreateUnoService("com.sun.star.sdbc.DriverManager")
		
		'
		oDriver = oDriverManager.getDriverByURL(oURL)
		oAccessTables= oDriver.getDataDefinitionByURL(oURL, oParams()).Tables
		'
		Dim oTable as Object
		Dim oTableName as String
			oTable = oAccessTables.getByIndex(0)
  			oTableName = oTable.Name
  			'
  		' Connect
		Dim oCon as Object
		Dim oStmt as Object
			oCon = oDriverManager.getConnection(oURL)
 			oStmt = oCon.createStatement()
 			'
  		' ResultSet		
  		Dim oSQL1 as String
  		Dim oRS as Object
  		Dim oIsBeforeFirst1, oIsAfterLast1, oIsFirst1, oIsLast1 as Boolean
  		Dim oIsBeforeFirst2, oIsAfterLast2, oIsFirst2, oIsLast2 as Boolean
  		Dim oIsBeforeFirst3, oIsAfterLast3, oIsFirst3, oIsLast3 as Boolean
  		Dim oIsBeforeFirst4, oIsAfterLast4, oIsFirst4, oIsLast4 as Boolean
  		Dim oIsBeforeFirst5, oIsAfterLast5, oIsFirst5, oIsLast5 as Boolean
  		Dim oIsBeforeFirst6, oIsAfterLast6, oIsFirst6, oIsLast6 as Boolean
  		Dim oIsBeforeFirst7, oIsAfterLast7, oIsFirst7, oIsLast7 as Boolean
  		Dim oRowNo1, oRowNo2, oRowNo3, oRowNo4, oRowNo5, oRowNo6, oRowNo7 as Integer
  			'
  			oStmt.ResultSetType = com.sun.star.sdbc.ResultSetType.SCROLL_INSENSITIVE
  			oSQL1 = "SELECT * FROM " & oTableName
  			oRS = oStmt.executeQuery(oSQL1)
  			'
  			oDisp = "File :  " & oAccessFile & Chr$(10) & "Table Name => " & oTableName & Chr$(10) & Chr$(10)
  			'
  			oRowNo1 = oRS.getRow()
  			oIsBeforeFirst1 = oRS.isBeforeFirst
  			oIsAfterLast1 = oRS.isAfterLast
  			oIsFirst1 = oRS.isFirst
  			oIsLast1 = oRS.isLast
  			oDisp = oDisp & "  現在のCurorのRow No => " & oRowNo1 & Chr$(10) & _
  						Chr$(9) & "isBeforeFirst => " & oIsBeforeFirst1 & Chr$(9) & "isAfterLast => " & oIsAfterLast1 & Chr$(10) & _
  						Chr$(9) & "isFirst => " & oIsFirst1 & Chr$(9) & "isLast => " & oIsLast1 & Chr$(10) & Chr(10)
  			'
  			oRS.Last
  			oRowNo2 = oRS.getRow()
  			oIsBeforeFirst2 = oRS.isBeforeFirst
  			oIsAfterLast2 = oRS.isAfterLast
  			oIsFirst2 = oRS.isFirst
  			oIsLast2 = oRS.isLast
  			oDisp = oDisp & "  現在のCurorのRow No => " & oRowNo2 & Chr$(10) & _
  						Chr$(9) & "isBeforeFirst => " & oIsBeforeFirst2 & Chr$(9) & "isAfterLast => " & oIsAfterLast2 & Chr$(10) & _
  						Chr$(9) & "isFirst => " & oIsFirst2 & Chr$(9) & "isLast => " & oIsLast2 & Chr$(10) & Chr(10)
  			'
  			oRS.Absolute(5)
  			oRowNo3 = oRS.getRow()
  			oIsBeforeFirst3 = oRS.isBeforeFirst
  			oIsAfterLast3 = oRS.isAfterLast
  			oIsFirst3 = oRS.isFirst
  			oIsLast3 = oRS.isLast
  			oDisp = oDisp & "  現在のCurorのRow No => " & oRowNo3 & Chr$(10) & _
  						Chr$(9) & "isBeforeFirst => " & oIsBeforeFirst3 & Chr$(9) & "isAfterLast => " & oIsAfterLast3 & Chr$(10) & _
  						Chr$(9) & "isFirst => " & oIsFirst3 & Chr$(9) & "isLast => " & oIsLast3 & Chr$(10) & Chr(10)
  			'
  			oRS.Relative(-2)
  			oRowNo4 = oRS.getRow()
  			oIsBeforeFirst4 = oRS.isBeforeFirst
  			oIsAfterLast4 = oRS.isAfterLast
  			oIsFirst4 = oRS.isFirst
  			oIsLast4 = oRS.isLast
  			oDisp = oDisp & "  現在のCurorのRow No => " & oRowNo4 & Chr$(10) & _
  						Chr$(9) & "isBeforeFirst => " & oIsBeforeFirst4 & Chr$(9) & "isAfterLast => " & oIsAfterLast4 & Chr$(10) & _
  						Chr$(9) & "isFirst => " & oIsFirst4 & Chr$(9) & "isLast => " & oIsLast4 & Chr$(10) & Chr(10)
  			'
  			oRS.First
  			oRowNo5 = oRS.getRow()
  			oIsBeforeFirst5 = oRS.isBeforeFirst
  			oIsAfterLast5 = oRS.isAfterLast
  			oIsFirst5 = oRS.isFirst
  			oIsLast5 = oRS.isLast
  			oDisp = oDisp & "  現在のCurorのRow No => " & oRowNo5 & Chr$(10) & _
  						Chr$(9) & "isBeforeFirst => " & oIsBeforeFirst5 & Chr$(9) & "isAfterLast => " & oIsAfterLast5 & Chr$(10) & _
  						Chr$(9) & "isFirst => " & oIsFirst5 & Chr$(9) & "isLast => " & oIsLast5 & Chr$(10) & Chr(10)
  			'
  			oRS.afterLast
  			oRowNo6 = oRS.getRow()
  			oIsBeforeFirst6 = oRS.isBeforeFirst
  			oIsAfterLast6 = oRS.isAfterLast
  			oIsFirst6 = oRS.isFirst
  			oIsLast6 = oRS.isLast
  			oDisp = oDisp & "  現在のCurorのRow No( End of result set ) => " & oRowNo6 & Chr$(10) & _
  						Chr$(9) & "isBeforeFirst => " & oIsBeforeFirst6 & Chr$(9) & "isAfterLast => " & oIsAfterLast6 & Chr$(10) & _
  						Chr$(9) & "isFirst => " & oIsFirst6 & Chr$(9) & "isLast => " & oIsLast6 & Chr$(10) & Chr(10)
  			'
  			oRS.beforeFirst
  			oRowNo7 = oRS.getRow()
  			oIsBeforeFirst7 = oRS.isBeforeFirst
  			oIsAfterLast7 = oRS.isAfterLast
  			oIsFirst7 = oRS.isFirst
  			oIsLast7 = oRS.isLast
  			oDisp = oDisp & "  現在のCurorのRow No( the Front of result set ) => " & oRowNo7 & Chr$(10) & _
  						Chr$(9) & "isBeforeFirst => " & oIsBeforeFirst7 & Chr$(9) & "isAfterLast => " & oIsAfterLast7 & Chr$(10) & _
  						Chr$(9) & "isFirst => " & oIsFirst7 & Chr$(9) & "isLast => " & oIsLast7
  			'
  		' Display 
  			msgbox(oDisp,0,"ResultSet Service")
  			'
  			oCon.Close()
		'
  		Exit Sub
  		'
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
		'
		oCon.Close
End Sub

BA-)[Base-MsAccess]Column情報を取得


Sub oMsAccess
	On Error Goto oBad
	Dim oDriveManager
	Dim oDriver
	Dim oURL as String
	Dim oAccessFile, oAccessURL as String
	Dim oParams(0) as New com.sun.star.beans.PropertyValue
	Dim oAccessTables
	Dim oDisp as String
		'
		oAccessFile = "c:\temp\ACCESS_SQL2003.mdb"
		'
		oAccessURL = ConvertToUrl(oAccessFile)
		If NOT FileExists(oAccessURL) then
			MsgBox( oAccessFile & " は存在しません", 0, "Caution !!")
			Exit Sub
		End If
		'
		oParams(0).Name = ""
		oParams(0).Value = ""
		'
		oURL = "sdbc:ado:PROVIDER=Microsoft.Jet.OLEDB.4.0;DATA SOURCE=" & oAccessFile
		'
		oDriverManager = CreateUnoService("com.sun.star.sdbc.DriverManager")
		
		'
		oDriver = oDriverManager.getDriverByURL(oURL)
		oAccessTables= oDriver.getDataDefinitionByURL(oURL, oParams()).Tables
		'
		Dim oTable as Object
		Dim oTableName as String
			oTable = oAccessTables.getByIndex(0)
  			oTableName = oTable.Name
  			'
  		' Connect
		Dim oCon as Object
		Dim oStmt as Object
			oCon = oDriverManager.getConnectionWithInfo(oURL,oParams())
 			oStmt = oCon.createStatement()
 			'
  		Dim oMetaData as Object
  		Dim oStrQuote as String
  			oMetaData = oCon.getMetaData()
  			oStrQuote = oMetaData.getIdentifierQuoteString()			' <= 「 ' 」を取得
  			'
  		Dim oSQL1 as String
  		Dim oRS as Object
  			oSQL1 = "SELECT * FROM " & oStrQuote & oTableName & oStrQuote
  			oRS = oStmt.executeQuery(oSQL1)
  			'
  		Dim oTableMeta as Object
  		Dim oColNum as Long
  			oTableMeta = oRS.getMetaData()
  			oColNum = oTableMeta.ColumnCount()
  			oDisp =""
  			for i = 1 to oColNum
  				oDisp = oDisp & "[ Column No." & i & " ]" & Chr$(10) 
  				oDisp = oDisp & "Column Name       => " & Chr$(9) & oTableMeta.getColumnName(i) & Chr$(10)
  				oDisp = oDisp & "Column Label       =>" & Chr$(9) & oTableMeta.getColumnLabel(i) & Chr$(10)
  				oDisp = oDisp & "DisplaySize           =>" & Chr$(9) & oTableMeta.getColumnDisplaySize(i) & Chr$(10)
  				oDisp = oDisp & "ColumnType         =>" & Chr$(9) & oTableMeta.getColumnType(i) & Chr$(10)
  				oDisp = oDisp & "ColumnTypeName =>" & Chr$(9) & oTableMeta.getColumnTypeName(i) & Chr$(10)
  				oDisp = oDisp & "Precision             =>" & Chr$(9) & oTableMeta.getPrecision(i) & Chr$(10)
  				oDisp = oDisp & "Scale                   =>" & Chr$(9) & oTableMeta.getScale(i) & Chr$(10)
  				oDisp = oDisp & "Table Name          =>" & Chr$(9) & oTableMeta.getTableName(i) & Chr$(10)
  				oDisp = oDisp & "SchemaName       =>" & Chr$(9) & oTableMeta.getSchemaName(i) & Chr$(10)
  				oDisp = oDisp & "IsAutoIncrement   =>" & Chr$(9) & oTableMeta.isAutoIncrement(i) & Chr$(10)
  				oDisp = oDisp & "IsCaseSensitive    =>" & Chr$(9) & oTableMeta.isCaseSensitive(i) & Chr$(10)
  				oDisp = oDisp & "IsCurrency           =>" & Chr$(9) & oTableMeta.isCurrency(i) & Chr$(10)
  				oDisp = oDisp & "IsNullable              =>" & Chr$(9) & oTableMeta.isNullable(i) & Chr$(10)
  				oDisp = oDisp & Chr$(10)
  			next i
  			msgbox oDisp,0,"Column情報"
  			'
  			oRS = Nothing
  		'
  		oCon.Close
  		msgbox "Success"
  		Exit Sub
  		'
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
		'
		oCon.Close
End Sub

BA-)[Base-MsAccess]Primary Key Column Nameの取得(*.mdb File)


Sub oMsAccess
	On Error Goto oBad
	Dim oDriveManager
	Dim oDriver
	Dim oURL as String
	Dim oAccessFile, oAccessURL as String
	Dim oParams(0) as New com.sun.star.beans.PropertyValue
	Dim oAccessTables
	Dim oDisp as String
	Dim oProvider as String
		'
		oAccessFile = "c:\temp\ACCESS_SQL2003.mdb"
		'
		oAccessURL = ConvertToUrl(oAccessFile)
		If NOT FileExists(oAccessURL) then
			MsgBox( oAccessFile & " は存在しません", 0, "Caution !!")
			Exit Sub
		End If
		'
		oParams(0).Name = ""
		oParams(0).Value = ""
		'
		oProvider = "PROVIDER=Microsoft.Jet.OLEDB.4.0;DATA SOURCE="
		oURL = "sdbc:ado:" & oProvider & oAccessFile
		'
		oDriverManager = CreateUnoService("com.sun.star.sdbc.DriverManager")
		
		'
		oDriver = oDriverManager.getDriverByURL(oURL)
		oAccessTables= oDriver.getDataDefinitionByURL(oURL, oParams()).Tables
		'
		Dim oTable as Object
		Dim oTableName as String
			oTable = oAccessTables.getByIndex(0)
  			oTableName = oTable.Name
  			'
  		' Connect
  		Dim oADOCon as Object
  		Dim oADOURL as String
  		Dim oRS as Object
  		Dim adSchemaPrimaryKeys
			adSchemaPrimaryKeys = 28
			'
			oADOCon = CreateObject("ADODB.Connection")
			oADOURL = oProvider & oAccessFile & ";"
 			oADOCon.Open(oADOURL)
 			oRS = oADOCon.OpenSchema(adSchemaPrimaryKeys, Array(,,oTableName))  
 			IF oRS.EOF Then
  				oDisp = "Primary Keyは設定されていません"
 			Else
  				n = 0
  				Do while NOT oRS.EOF
   					ReDim Preserve sKeyNames(n) As string 
						sKeyNames(n) = oRS.Fields.Item("COLUMN_NAME").value
   						oRS.MoveNext
   						n = n + 1
  				Loop
 				oDisp = "Table Name => " & oTableName & Chr$(10) & Chr$(9) & "Primary Key Column Name => " & sKeyNames(n-1)
 			End IF
 			'
 			msgbox oDisp,0,"Column Name of Primary Key for MS-ACCESS Table"
 			'
 			oRS.Close
 			oADOCon.Close
 			oRS = Nothing
 			oADOCon = Nothing
			'
		msgbox "Success"
  		Exit Sub
  		'
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
		'
		oRS.Close
 		oADOCon.Close
 		oRS = Nothing
 		oADOCon = Nothing
End Sub

BA-)[Base-MsAccess]Primary Key Column Nameの取得(*.accdb File)


Sub oMsAccess
	On Error Goto oBad
	Dim oDriveManager
	Dim oDriver
	Dim oURL as String
	Dim oAccessFile, oAccessURL as String
	Dim oParams(0) as New com.sun.star.beans.PropertyValue
	Dim oAccessTables
	Dim oDisp as String
	Dim oProvider as String
		'
		oAccessFile = "c:\temp\ACCESS_SQL2007.accdb"
		'
		oAccessURL = ConvertToUrl(oAccessFile)
		If NOT FileExists(oAccessURL) then
			MsgBox( oAccessFile & " は存在しません", 0, "Caution !!")
			Exit Sub
		End If
		'
		oParams(0).Name = ""
		oParams(0).Value = ""
		'
		oProvider = "PROVIDER=Microsoft.ACE.OLEDB.12.0;DATA SOURCE="
		oURL = "sdbc:ado:" & oProvider & oAccessFile
		'
		oDriverManager = CreateUnoService("com.sun.star.sdbc.DriverManager")
		
		'
		oDriver = oDriverManager.getDriverByURL(oURL)
		oAccessTables= oDriver.getDataDefinitionByURL(oURL, oParams()).Tables
		'
		Dim oTable as Object
		Dim oTableName as String
			oTable = oAccessTables.getByIndex(0)
  			oTableName = oTable.Name
  			'
  		' Connect
  		Dim oADOCon as Object
  		Dim oADOURL as String
  		Dim oRS as Object
  		Dim adSchemaPrimaryKeys
			adSchemaPrimaryKeys = 28
			'
			oADOCon = CreateObject("ADODB.Connection")
			oADOURL = oProvider & oAccessFile & ";"
 			oADOCon.Open(oADOURL)
 			oRS = oADOCon.OpenSchema(adSchemaPrimaryKeys, Array(,,oTableName))  
 			IF oRS.EOF Then
  				oDisp = "Primary Keyは設定されていません"
 			Else
  				n = 0
  				Do while NOT oRS.EOF
   					ReDim Preserve sKeyNames(n) As string 
						sKeyNames(n) = oRS.Fields.Item("COLUMN_NAME").value
   						oRS.MoveNext
   						n = n + 1
  				Loop
 				oDisp = "Table Name => " & oTableName & Chr$(10) & Chr$(9) & "Primary Key Column Name => " & sKeyNames(n-1)
 			End IF
 			'
 			msgbox oDisp,0,"Column Name of Primary Key for MS-ACCESS Table"
 			'
 			oRS.Close
 			oADOCon.Close
 			oRS = Nothing
 			oADOCon = Nothing
			'
		msgbox "Success"
  		Exit Sub
  		'
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
		'
		oRS.Close
 		oADOCon.Close
 		oRS = Nothing
 		oADOCon = Nothing
End Sub

BA-)[Base-MsAccess]ADO RecordsetでTable Open(*.mdb File)



BA-)[Base-MsAccess]ADO RecordsetでTable Open(*.mdb File)

Sub oMsAccess
	On Error Goto oBad
	Dim oAccessFile, oAccessURL as String
	Dim oDisp as String
	Dim oProvider as String
		'
		oAccessFile = "c:\temp\Macro_Database2.accdb"
		'
		oAccessURL = ConvertToUrl(oAccessFile)
		If NOT FileExists(oAccessURL) then
			MsgBox( oAccessFile & " は存在しません", 0, "Caution !!")
			Exit Sub
		End If
		'
		oProvider = "PROVIDER=Microsoft.ACE.OLEDB.12.0;DATA SOURCE="
		'
  		' Connect
  		Dim oADOCon as Object
  		Dim oADOURL as String
  		Dim oRS as Object
  		Dim oTbName as String
  		'
		' ADO Connection 
			oADOCon = CreateObject("ADODB.Connection")
			oADOURL = oProvider & oAccessFile & ";"
 			oADOCon.Open(oADOURL)
 		' Recordset
 			oRS = CreateObject("ADODB.Recordset")
 			oTbName = "AccessTb"
 			'
 		' RecordsetによるTable open
 			 oRS.Open oTbName, oADOCon, adOpenKeyset, adLockOptimistic
 			'
 		' Colose Recordset
 			oRS.Close
 			oRS = Nothing
 		' MS-Accessとの接続Close
 			oADOCon.Close
 			oADOCon = Nothing
			'
		msgbox "Success"
  		Exit Sub
  		'
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
		'
		oRS.Close
 		oADOCon.Close
 		oRS = Nothing
 		oADOCon = Nothing
End Sub

BA-)[Base-MsAccess]ADO RecordsetでSQL set(*.mdb File)



BA-)[Base-MsAccess]ADO RecordsetでSQL set(*.mdb File)

Sub oMsAccess
	On Error Goto oBad
	Dim oAccessFile, oAccessURL as String
	Dim oDisp as String
	Dim oProvider as String
		'
		oAccessFile = "c:\temp\Macro_Database2.accdb"
		'
		oAccessURL = ConvertToUrl(oAccessFile)
		If NOT FileExists(oAccessURL) then
			MsgBox( oAccessFile & " は存在しません", 0, "Caution !!")
			Exit Sub
		End If
		'
		oProvider = "PROVIDER=Microsoft.ACE.OLEDB.12.0;DATA SOURCE="
		'
  		' Connect
  		Dim oADOCon as Object
  		Dim oADOURL as String
  		Dim oRS as Object
  		Dim oTbName as String
  		Dim oSQL as String
  		'
		' ADO Connection 
			oADOCon = CreateObject("ADODB.Connection")
			oADOURL = oProvider & oAccessFile & ";"
 			oADOCon.Open(oADOURL)
 		' Recordset
 			oRS = CreateObject("ADODB.Recordset")
 			oTbName = "AccessTb"
 			oSQL = "SELECT [" & oTbName & "].* FROM [" & oTbName & "] WHERE([" & oTbName & "].[No] > 30);"		' <= MS-AccessのSQL構文
 			'
 		' RecordsetによるTable open
 			 oRS.Open oSQL, oADOCon, adOpenKeyset, adLockOptimistic
 			'
 		' Colose Recordset
 			oRS.Close
 			oRS = Nothing
 		' MS-Accessとの接続Close
 			oADOCon.Close
 			oADOCon = Nothing
			'
		msgbox "Success"
  		Exit Sub
  		'
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
		'
		oRS.Close
 		oADOCon.Close
 		oRS = Nothing
 		oADOCon = Nothing
End Sub

BA-)[Base-MsAccess]MS-ACCESS2007からHSQLDBへTable Data移行


Sub oMsAccess
	On Error Goto oBad
	' HSQLDBの設定
	Dim oDoc as Object
	Dim oHsqlDbURL as String
		oDoc = ThisComponent
		oHsqlDbURL = oDoc.getURL()
		'
	Dim oBaseContext as Object
	Dim oHsqlDB as Object
	Dim oHsqlCon as Object
	Dim oStmt as Object
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  		oHsqlDB = oBaseContext.getByName(oHsqlDbURL)
  		oHsqlCon = oHsqlDB.getConnection("", "")
		'
		oStmt = oHsqlCon.createStatement()
		'
	' CREATE TABLE句
	Dim oSQL1 as String
	Dim oSQL2 as String
	Dim oHsqlTb as String
  	' 既存Tableがあると削除する
  		oHsqlTb = "TEST"
  		oSQL1 = "DROP TABLE " & oHsqlTb & " IF EXISTS;  "
		oStmt.execute(oSQL1)
		'
  		oSQL2 = "CREATE TABLE " & oHsqlTb & "(NO varchar(10), NAME varchar(50)) "
		oStmt.execute(oSQL2)
		'
		'
	' MS-Access
	Dim oAccessFile, oAccessURL as String
	Dim oDisp as String
	Dim oProvider as String
		'
		oAccessFile = "c:\temp\Macro_Database2.accdb"
		'
		oAccessURL = ConvertToUrl(oAccessFile)
		If NOT FileExists(oAccessURL) then
			MsgBox( oAccessFile & " は存在しません", 0, "Caution !!")
			Exit Sub
		End If
		'
		oProvider = "PROVIDER=Microsoft.ACE.OLEDB.12.0;DATA SOURCE="
		'
  		' Connect
  		Dim oADOCon as Object
  		Dim oADOURL as String
  		Dim oRS as Object
  		Dim oTbName as String
  		Dim oSQL as String
  		'
		' ADO Connection 
			oADOCon = CreateObject("ADODB.Connection")
			oADOURL = oProvider & oAccessFile & ";"
 			oADOCon.Open(oADOURL)
 		' Recordset
 			oRS = CreateObject("ADODB.Recordset")
 			oTbName = "AccessTb"
 			oSQL = "SELECT [" & oTbName & "].* FROM [" & oTbName & "];"		' MS-AccessのSQL構文
 			'
 		' RecordsetによるTable open
 			 oRS.Open oSQL, oADOCon, adOpenKeyset, adLockOptimistic
 			'
 			'
 		' MS-Access DataをHSQLDBへ
 		Dim oValue as String
 		Dim oSqlData as String
 		Dim nn as Long
 		Dim oLimit as Long
 		Dim oFieldTmp01 as String
 		Dim oFieldTmp02 as String
 			oLimit = 1000
 			'
 			nn = 0
 			oRS.MoveFirst
 			Do Until oRS.EOF or nn > oLimit
 				' RecordsetからData取得
 				oFieldTmp01 = CStr(oRS.Fields.Item("No").value)
 				oFieldTmp02 = CStr(oRS.Fields.Item("Name").value)
 				'
 				' HSQLDBへInsert
 				oValue = "VALUES('" & oFieldTmp01 & "','" & oFieldTmp02 & "');"
 				oSqlData =  "INSERT INTO " & oHsqlTb & "(NO, NAME)" & " " & oValue
 				oStmt.executeUpdate(oSqlData)
 				'
 				oRS.MoveNext
 				'
 				nn = nn + 1
 				If nn > oLimit then
 					Exit Do
 				End If
 			Loop
 			'
 			'
 		' Colose Recordset
 			oRS.Close
 			oRS = Nothing
 		' MS-Accessとの接続Close
 			oADOCon.Close
 			oADOCon = Nothing
			'
			'
		' HSQLDBのClose
			oHsqlCon.close()
			'
		msgbox "Success"
  		Exit Sub
  		'
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
		'
		oRS.Close
 		oADOCon.Close
 		oRS = Nothing
 		oADOCon = Nothing
 		'
 		oHsqlCon.close()
End Sub

BA-)[Base-MsAccess]MS-ACCESSのRecordCount取得


Sub oMsAccess
	On Error Goto oBad
	' MS-Access
	Dim oAccessFile, oAccessURL as String
	Dim oDisp as String
	Dim oProvider as String
		'
		oAccessFile = "c:\temp\Macro_Database2.accdb"
		'
		oAccessURL = ConvertToUrl(oAccessFile)
		If NOT FileExists(oAccessURL) then
			MsgBox( oAccessFile & " は存在しません", 0, "Caution !!")
			Exit Sub
		End If
		'
		oProvider = "PROVIDER=Microsoft.ACE.OLEDB.12.0;DATA SOURCE="
		'
  		' Connect
  		Dim oADOCon as Object
  		Dim oADOURL as String
  		Dim oRS as Object
  		Dim oTbName as String
  		Dim oSQL as String
  		'
		' ADO Connection 
			oADOCon = CreateObject("ADODB.Connection")
			oADOURL = oProvider & oAccessFile & ";"
 			oADOCon.Open(oADOURL)
 		' Recordset
 			oRS = CreateObject("ADODB.Recordset")
 			oTbName = "AccessTb"
 			oSQL = "SELECT Count(*) as [Cnt] FROM [" & oTbName & "];"		' MS-AccessのSQL構文
 			'
 		' RecordsetによるTable open
 			 oRS.Open oSQL, oADOCon, adOpenStatic, 1
 			'
 		' Record数Coout
 		Dim oRecordNum as Long
 			'oRecordNum = oRS.RecordCount								' returnが -1 になる。
 			oRecordNum = oRS.Fields.Item("Cnt").value  + 1		' 最初のRecordが0とCountされる為 + 1
 			'
 			msgbox(oRecordNum,0,"MS-AccessのRecord数")
 			
 		' Colose Recordset
 			oRS.Close
 			oRS = Nothing
 		' MS-Accessとの接続Close
 			oADOCon.Close
 			oADOCon = Nothing
			'
		msgbox "Success"
  		Exit Sub
  		'
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
		'
		oRS.Close
 		oADOCon.Close
 		oRS = Nothing
 		oADOCon = Nothing
 		'
 		oHsqlCon.close()
End Sub

BA-)[Base-MsAccess]





Other[Base]

BO-)DatabaseのVersion( HSQLDB )


Sub oDatabaseVer
	On Error Goto oBad
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("Test")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oVersion as String
			oVersion = oCon.getMetaData().getDatabaseProductVersion()
			oDisp = "本BaseのHSQLDBのVersionは" & Chr$(10) & "  ver." & oVersion & Chr$(10) & "です。"
			msgbox(oDisp,0,"HSQLDB Version")
		'
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose
		'
		msgbox "Success"
		Exit Sub
		'
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")		
End Sub
'
' [ Note ]
' 1) 違うVersionのLibreOffice( Apache OpenOffice )で作成したFileに対して実行すると、Return値がおかしい場合がある。( verion 0 等 )
'    新規でDB Fileを作成してから実行する。
' 2) HSQL DBのVersionを2.xに変更すると、SQLでVersion取得が可能らしい。( ask.LibreOffice.org / How to check the underlying SQL in Base )

BO-)DatabaseのVersion( MySQL )


Sub oMySQL
	On Error Goto oBad
	Dim oBaseContext
	Dim oUser$
	Dim oPass$
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource
		Dim oCon
			oDataSource = oBaseContext.getByName("MySQL_local")
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oVersion as String
			oVersion = oCon.getMetaData().getDatabaseProductVersion()
			oDisp = "本BaseのMySQLのVersionは" & Chr$(10) & "  ver." & oVersion & Chr$(10) & "です。"
			msgbox(oDisp,0,"MySQL Version")
		'
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose
		'
		msgbox "Success"
		Exit Sub
		'
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")		
End Sub

BO-)Database Engine名取得( HSQLDB )


Sub EmbdDB()
	On Error Goto oBad
	Dim oDoc as Object, oBaseContext as Object
	Dim oTempName as String, oUser as String, oPass as String
		oDoc = ThisComponent
		oTempName = oDoc.getURL
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource as Object, oCon as Object
			oDataSource = oBaseContext.getByName(oTempName)
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oDbEngName as String, oDisp as String
			oDbEngName = oCon.getMetaData().getDatabaseProductName()
			oDisp = "本BaseのDatabase Engineは" & Chr$(10) & oDbEngName & Chr$(10) & "です。"
		msgbox(oDisp,0,"LO5.0.1.2")
		'
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose
		'
		msgbox "Success"
		Exit Sub
		'
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")		
End Sub

BO-)(未完成)Database Engine名取得( Firebird )


Sub EmbdDB()
	On Error Goto oBad
	Dim oDoc as Object, oBaseContext as Object
	Dim oTempName as String, oUser as String, oPass as String
		oDoc = ThisComponent
		oTempName = oDoc.getURL
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource as Object, oCon as Object
			oDataSource = oBaseContext.getByName(oTempName)
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oDbEngName as String, oDisp as String
			oDbEngName = oCon.getMetaData().getDatabaseProductName()
			oDisp = "本BaseのDatabase Engineは" & Chr$(10) & oDbEngName & Chr$(10) & "です。"
		msgbox(oDisp,0,"LO5.0.1.2")
		'
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose
		'
		msgbox "Success"
		Exit Sub
		'
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")		
End Sub
' [ Note ]
' Macro code is same for HSQLDB, but return value is nothing without error.
' Reference : Firebird / getDatabaseProductName

BO-)[Base]OpenOfficeのBaseで画像データベース【blog 「Suneo Soft -maglog」より抜粋


Sub Main
	oForm = ThisComponent.DrawPage.Forms.getByName("MainForm")
	oDoc = ThisComponent
	oFrames = oDoc.getTextFrames()
	oGraphics=oDoc.getGraphicObjects()
	oFrame = oFrames.getByName( "枠1" )
	oFrameCursor = oFrame.createTextCursor()
	oFrameCursor.gotoStart( False )
	'イメージコントロールとは異なり、現在表示されている画像を消す必要がある。
	If oGraphics.hasByName( "グラフィックス1" ) Then
		oGraphic=oGraphics.getByName( "グラフィックス1" )
		oFrameCursor.text.removeTextContent(oGraphic)
	EndIf
	oGraphic = oDoc.createInstance("com.sun.star.text.GraphicObject")
	oTxtbox = oForm.GetByName("txtFileName")
	oPath = oForm.GetByName("Path")
	oGraphic.GraphicURL= "file:///" + oPath.text + oTxtbox.text
	oFrameCursor.text.insertTextContent(oFrameCursor, oGraphic, False)
	oButton = oForm.GetByName("PushButton")
	oButton.TargetURL = oGraphic.GraphicURL
End Sub

BO-)Embedded Database( HSQLDB / FireBird )


Sub EmbdDB()
	On Error Goto oBad
	Dim oDoc as Object, oBaseContext as Object
	Dim oTempName as String, oUser as String, oPass as String
		oDoc = ThisComponent
		oTempName = oDoc.getURL
		oUser = ""
		oPass = ""
		oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
		' Connect with the DataSource
		Dim oDataSource as Object, oCon as Object
			oDataSource = oBaseContext.getByName(oTempName)
			oCon = oDataSource.getConnection(oUser, oPass)
		Dim oEmbeddedDB as String, oDisp as String
			oEmbeddedDB = oCon.getMetaData().getURL()
			oDisp = "Embedded Database" & Chr$(10) & " ⇒ " & oEmbeddedDB
		msgbox(oDisp,0,"LO5.0.1.2")
		'
		'Unconnect with the Datasource
		oCon.close()
		oCon.dispose
		'
		msgbox "Success"
		Exit Sub
		'
	oBad:
		oCon.Close()
  		oCon.dispose
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")		
End Sub

BO-)[Base](未完成)TableにImageDataを追加

Sub oImageDataintoTable	'(未完成)
	'Create New Base Document 
		Dim oDoc
		Dim Dummy()
		Dim oAns
		Dim oBaseFile
		Dim oBaseURL
			oBaseFile = "C:\temp\oBase_Table.odb"
			oBaseURL = ConvertToUrl(oBaseFile)
			oDoc = StarDesktop.loadComponentFromURL(oBaseURL, "_dedault", 0, Dummy())
			oDataSource = oDoc.DataSource
 			'set to use hsqldb
 				oDataSource.URL = "sdbc:embedded:hsqldb"
 			'Get File URL
 				oTempName = oDoc.getURL()
 			'Load the Tools library
				If NOT GlobalScope.BasicLibraries.isLibraryLoaded("Tools") Then
					GlobalScope.BasicLibraries.LoadLibrary("Tools")
				End If	
			'Pickup the FileName without the path.
				Dim oFileName
  					oFileName = FileNameOutOfPath(oTempName, "/")	
			'Connect DB
				Dim oBaseContent
				Dim oDB
				Dim oCon
					oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  					oDB = oBaseContext.getByName(oTempName)
  					oCon = oDB.getConnection("", "")
  			'Get the Table Name
  				Dim oTable
  				Dim oTNames()
  				Dim oTableName
  					oTables=oCon.getTables
					oTNames=oTables.getElementNames()
					oTableName = oTNames(1)
 			'File Access
 				Dim oFileAccess
 				Dim oStream
  					oFileAccess = createUnoService( "com.sun.star.ucb.SimpleFileAccess")
  					oStream = oFileAccess.openFileRead(oTempName)
  			'Get Image Files and File Size[ Bytes ]
  				Dim oData
  				Dim oImageDir
  				Dim oImageFileName
  				Dim oLen
  					oImageDir = "c:\Temp\ImageForMacroTest\"
  					oImageDirURL = ConvertToURL(oImageDir)
  					oImageFileName = dir(oImageDirURL)	
  					oData = StarDesktop(oImageDirURL & oImageFileName, "_defalut", 0, Dummy)
  					oData.dispose
  				'Document Change
  					oDoc.getCurrentController()
  					oLen = oStream.getLength()
  					oStream.readBytes(oData, oLen)
  					oFileByte = CStr(oStream.readBytes(oData, oLen))
  			'Prepared statement to insert the data by Query
  				'[ Note ]  : It is not neccessary to set the ID Item because it is an auto-value field.
  					Dim oSQL As String
  					Dim oStatement		
  						'Define Setted Items(ID, ImageFileName, FileSize, Image) in the Table. and Defaut TableValue of the Items are Empty.
  							'[ Note ] :  To be define ITem Name and Format in the Table before Excuting Macro. 
  								oSQL = "insert into" & " " & oTableName & " " & "(FILENAME, SIZE, IMAGE ) values (?, ?, ?)" 
  						oStatement = oCon.PrepareStatement(oSQL)
  				'Add the TableValues
  				'	oStatement.SetString(Column No , DataValue)
  						oIData = oImageDir & dir(oImageDirURL)
  						oStatement.setString( 1, oImageFileName)
  						oStatement.setString( 2, oFileByte)
  						oStatement.setBytes(3, oData, oLen)
  				'Execute the Query
  						oStatement.ExecuteUpdate()
  				oStream.closeInput()
  		'DataBaseとのConnect切断
  			oCon.close()
  			oDoc.close(true)
    	msgbox("Success")		
End Sub
'
'[ Caution ] : TABLENAME And ITEM To be Capital Charactor!!.


Top of Page


inserted by FC2 system