ExcelからAccessのテーブルを取得する／CalcからBaseの場合は？ Database access on Microsoft Access from Excel / LibreOffice Base from Calc

少しずつLibreOffice Basicの勉強を進めていますが、元々セル操作ですらVBAと互換性が無いのに、ちょっと手の込んだことをやろうとすると、荒野に放り出される如く。

まずLibreOffice BasicのIDEがショボイのと、「分からなくてネットで検索すると、関数名がJavaだからJavaのページが引っかかってしまう」ことが逆風となり、お金を出してでもMicrosoftの快適な都市生活に戻りたくなってしまいますね。しかし、Officeに月額料金を払うべきは、それを使って売り上げを発生させることが出来る人だけです。

今回は、データベースを参照して、あるテーブルのデータをワークシートにコピーするプログラムの紹介です。このままでは実用的ではありませんが、クエリで出来ない操作を行う・外部提出用フォーマットに整形する・表計算ソフトしか触れない人にデータベースを意識させない場合に活用できます。

ExcelからAccessのテーブルを取得する

ADODBを使う方法です。Worksheet.Range.CopyFromRecordsetを使うことで、クエリ結果をペタッと貼り付けることができます。ただし、項目名は別途読み込んで、１列目に記入する必要があります。Connection.Providerの値を変えることで、Oracleなど他のデータベースにも接続できます。

Option Explicit

Public Sub do_getTable()

    'Connect to Accesss(local file)
    Dim Connection As ADODB.Connection
    Set Connection = connectToAccess("C:\Users\denco\Documents\masters_data.accdb")
    
    'Get Table
    Dim Recordset As New ADODB.Recordset
    Dim strSQL As String
    strSQL = "SELECT * FROM dencos;"
    
    With Recordset
        .ActiveConnection = Connection
        .Source = strSQL
        .CursorType = adOpenKeyset
        .LockType = adLockOptimistic
        .CursorLocation = adUseClient
        .Open
    End With
    
    'Import Table
    Dim mainSheet As Worksheet
    Set mainSheet = ThisWorkbook.Worksheets("main")
    
    Dim countColumn As Integer
    For countColumn = 1 To Recordset.Fields.Count
        mainSheet.Cells(1, countColumn) = Recordset.Fields.Item(countColumn - 1).Name
    Next
                
    mainSheet.Range("A2").CopyFromRecordset Recordset
    
    'Close Database
    Recordset.Close
    Connection.Close
    Set Connection = Nothing
    
End Sub


Private Function connectToAccess(filename As String) As ADODB.Connection
    On Error GoTo openError
    
    Dim Connection As New ADODB.Connection
    
    With Connection
        .Provider = "Microsoft.Ace.OLEDB.12.0"
        .Properties("Data Source").Value = filename
        .Open
    End With
    
    Set connectToAccess = Connection
    
    Exit Function

'Error Process
openError: 
    Set connectToAccess = Nothing
    
End Function

CalcからBaseのテーブルを取得する

Baseをファイル名で直接参照することができないので、DatabaseContext.registerObjectで登録した後に、登録名でアクセスします。これはGUIの「ツールーオプションーLibreOffice Baseーデータベース」でも設定できて、一度設定すると別ファイルでも維持されるため、二重登録を防がないとエラーが出ます（ややこしいので要注意）。ファイル名の頭には「file:///」を付け、パス区切り文字は\でなく/（スラッシュ）となります。

また、Baseを表示させないで参照するためには、StarDesktop.loadComponentFromURLの"_hidden"オプションだけでなく、FilePropertiesでも明記しなければいけません（バグ？）。

動作はExcel-Accessに比べて遅いですが、大規模データなら元からデータベースサーバーを組んでいると思われるので、一般的な顧客やクラス名簿程度に限れば実用的なスピードで動くと思われます。

有用な情報は英語のページしか無くて苦労しますが、できないことはありません。見た目がJavaScriptっぽくて、可読性は許容範囲と思います。getCellByPositionなんてカッコいいですが、VBAのCellsと行・列の記載が逆なのがトラップです(笑)

Sub do_getTable

'Connect to Base(local file)
Dim Connection as Object
Connection = connectToBase("file:///C:/Users/denco/Documents/masters_data.odb")

'Get Table
Dim Statement as Object
Dim ResultSet as Object
Statement = Connection.createStatement()
ResultSet = Statement.executeQuery("SELECT * FROM [dencos]")

'Import Table
If  IsNull(ResultSet) Then
  'Error Process
Else
Dim mainSheet As Object
mainSheet= ThisComponent.Sheets.getByName("main")

Dim col As Integer

For col = 0 to ResultSet.columns.Count - 1 
mainSheet.getCellByPosition(col, 0).String =  ResultSet.Columns.ElementNames(col)
Next

Dim resultRow As Double
resultRow = 1
  Do While ResultSet.next
  For col = 0 to ResultSet.columns.Count - 1 
    mainSheet.getCellByPosition(col, resultRow).String = ResultSet.getString(col + 1)
    Next
   
    resultRow = resultRow + 1
    Loop
End If

'Close Database
Statement.Close()
Connection.Close()
Connection.Dispose()

End Sub

Function connectToBase(filename As String) As Object

Dim DatabaseContext as Object
Dim DatabaseFile as Object
Dim DataSource as Object
Dim CurrentDbName as String
CurrentDbName = "dencos_master_db" ' Any name you have never used

' This option and loadComponentFromURL's "_hidden" are both need for hide Base's window
Dim FileProperties(0) as new com.sun.star.beans.PropertyValue
    FileProperties(0).Name = "Hidden"
    FileProperties(0).Value = True

' open database (LibreOffice Base)
DatabaseContext=createUnoService("com.sun.star.sdb.DatabaseContext") 
DatabaseFile = StarDesktop.loadComponentFromURL( filename, "_hidden", 0, FileProperties)

  If Not DatabaseContext.hasByName(CurrentDbName) Then
  DatabaseContext.registerObject(CurrentDbName, DatabaseFile.DataSource)
End If

DataSource = DatabaseContext.getByName(CurrentDbName)

' connect with empty user/pass
connectToBase = DataSource.GetConnection("","")

End Function