Home of site
Macroの杜
(OpenOffice.org/LibreOffice Basic編)
Base No.2
**********************【 Index 】**********************
HSQLDB : SQL( Query )
Firebird : SQL( Query )[ Development/Base/FirebirdSQL ] / [ Firebird 2.5 Language Reference Update ]
MySQL[Base]
[ Table ]
MS-ACCESS[Base]
BA-)[Base-MsAccess]MS-ACCESS2003 DataにConnect(*.mdb File)[ sdbc:ado:PROVIDER=Microsoft.Jet.OLEDB.4.0 / com.sun.star.sdbc.DriverManager ]
BA-)[Base-MsAccess]MS-ACCESS2007 DataにConnect(*.accdb File)[ sdbc:ado:PROVIDER=Microsoft.ACE.OLEDB.12.0 / com.sun.star.sdbc.DriverManager ]
BA-)[Base-MsAccess]Table Nameの取得(*.mdb File)[ getDriverByURL() / getDataDefinitionByURL() / Tables / Count / getByIndex() / Name ]
BA-)[Base-MsAccess]Table Nameの取得(*.accdb File)[ getDriverByURL() / getDataDefinitionByURL() / Tables / Count / getByIndex() / Name ]
BA-)[Base-MsAccess]Tableの行No.の取得(*.mdb File)[ executeQuery() / Last / First / Previous / Next / Row ]
BA-)[Base-MsAccess]Tableの行No.の取得(*.accdb File)[ executeQuery() / Last / First / Previous / Next / Row ]
BA-)[Base-MsAccess]現在のCurosr位置判定(*.mdb File)[ afterLast / beforeFirst / getRow() / isBeforeFirst / isAfterLast / isFirst / isLast ]
BA-)[Base-MsAccess]現在のCurosr位置判定(*.accdb File)[ afterLast / beforeFirst / getRow() / isBeforeFirst / isAfterLast / isFirst / isLast ]
BA-)[Base-MsAccess]Column情報を取得[ getConnectionWithInfo / getColumnType() / getColumnTypename() / getPrecision() / getScale() / getSchemaName() / getTableName() / isAutoIncrement() / isCaseSensitive() / isCurrency() / isNullable() ]
BA-)[Base-MsAccess]Primary Key Column Nameの取得(*.mdb File)[ CreateObject("ADODB.Connection") / OpenSchema / OpenSchema ]
BA-)[Base-MsAccess]Primary Key Column Nameの取得(*.accdb File)[ CreateObject("ADODB.Connection") / OpenSchema / OpenSchema ]
BA-)[Base-MsAccess]ADO RecordsetでTable Open(*.mdb File)[ CreateObject("ADODB.Recordset") / .Open Table, oCon, adOpenKeyset, adLockOptimistic ]
BA-)[Base-MsAccess]ADO RecordsetでTable Open(*.accdb File)[ CreateObject("ADODB.Recordset") / .Open Table, oCon, adOpenKeyset, adLockOptimistic ]
BA-)[Base-MsAccess]ADO RecordsetでSQL set(*.mdb File)[ CreateObject("ADODB.Recordset") / .Open SQL, oCon, adOpenKeyset, adLockOptimistic ]
BA-)[Base-MsAccess]ADO RecordsetでSQL set(*.accdb File)[ CreateObject("ADODB.Recordset") / .Open SQL, oCon, adOpenKeyset, adLockOptimistic ]
BA-)[Base-MsAccess]MS-ACCESS2007からHSQLDBへTable Data移行[ .EOF / .Fields.Item("").value / .MoveFirst / .MoveNext ]
BA-)[Base-MsAccess]MS-ACCESSのRecordCount取得[ Count(*) as [] ]
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作成後、再度、oStmｔの作成が必要
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削除後は再度、oStmｔの作成が必要
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作成後、再度、oStmｔの作成が必要
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削除後は再度、oStmｔの作成が必要
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作成後、再度、oStmｔの作成が必要
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削除後は再度、oStmｔの作成が必要
oSQL = "CREATE TABLE " & oTbName2 & "(ID INT PRIMARY KEY, NAME VARCHAR(20)); "
oStmt.execute(oSQL)
oStmt = oCon.createStatement() ' Firebird ではTable作成後、再度、oStmｔの作成が必要
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削除後は再度、oStmｔの作成が必要
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作成後、再度、oStmｔの作成が必要
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削除後は再度、oStmｔの作成が必要
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作成後、再度、oStmｔの作成が必要
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 Ｔａｂｌｅ
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
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!!.
