LibreOfficeでPostgreSQLデータベースにJDBCで接続

On Error Goto ErrorHandler
'Properties
Dim properties(2) As New com.sun.star.beans.PropertyValue
properties(0).Name = "user"
properties(0).value = "UserName"
properties(1).Name = "password"
properties(1).value = "Pass"
properties(2).name = "JavaDriverClass"
properties(2).value = "org.postgresql.Driver"
'Driver manager
Dim driverManager As Object
driverManager = createUnoService("com.sun.star.sdbc.DriverManager")
'Connection
Dim connection As Object
connection = driverManager.getConnectionWithInfo("jdbc:postgresql://192.168.0.1:5432/database-name", properties())
'Statement
Dim statement As Object
statement = connection.createStatement()
'Execute and number of update records
Print statement.executeUpdate("DELETE FROM table1;")
'ResultSet
Dim resultSet As Object
resultSet = statement.executeQuery("SELECT * FROM table2;")
While resultSet.Next
    Print resultSet.getString(1)
Wend
'Close
statement.close()
connection.close()
connection.dispose()
Exit Sub
'Error handle
ErrorHandler:
If IsNull(statement) = false Then
    If statement.isClosed() = false Then
        statement.close()
    End If
End If
If IsNull(connection) = false Then
    If connection.isClosed() = false Then
        connection.close()
        connection.dispose()
    End If
End If
If InStr(Error$, "org.postgresql.Driver") > 0 Then
    MsgBox("ツール→オプション→LibreOffice→詳細→クラスパスからPostgreSQLのJDBCドライバーを追加してください。", 64, "初期設定")
Elseif Len(Error$) > 0 Then
    MsgBox(Error$, 16, "エラー")
End If

LibreOffice Calcでダイアログを作成して表示する

「ツール」→「マクロ」→「ダイアログの管理」から追加した”Dialog1″を表示してダイアログ内のテキストフィールドの値を取得するコード。ちなみにダイアログをコードで閉じるにはdialogオブジェクトのendexecute()メソッドを呼ぶ。

'Show dialog
DialogLibraries.LoadLibrary("Standard")
dialog = CreateUnoDialog(DialogLibraries.Standard.Dialog1)
dialog.execute()
'Get text
Dim textField As Object
textField = dialog.getControl("TextField1")
Dim value As String
value = textField.getText()

ファイルの保存ダイアログを表示する

Dim filePicker As Object
Dim saveFiles() As Variant
Dim saveFileUrl As String
Dim saveFilePath As String

filePicker = createUnoService("com.sun.star.ui.dialogs.FilePicker")
filePicker.initialize(Array(com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_SIMPLE))

filePicker.appendFilter("テキストファイル(*.txt)", "*.txt")

If filePicker.execute() = 1 Then
    saveFiles = filePicker.getFiles()
    saveFileUrl = saveFiles(0)
    saveFilePath = ConvertFromURL(saveFileUrl)
    MsgBox(saveFilePath) '拡張子付いてないかも
End If

ファイルの選択ダイアログを表示する

Dim filePicker As Object
Dim loadFiles() As Variant
Dim loadFileUrl As String
Dim loadFilePath As String

filePicker = createUnoService("com.sun.star.ui.dialogs.FilePicker")
filePicker.initialize(Array(com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE))

filePicker.appendFilter("テキストファイル(*.txt)", "*.txt")
filePicker.appendFilter("HTMLファイル(*.htm, *.html)", "*.htm;*.html")
filePicker.appendFilter("すべてのファイル(*.*)", "*.*")

If filePicker.execute() = 1 Then
    loadFiles = filePicker.getFiles()
    loadFileUrl = loadFiles(0)
    loadFilePath = ConvertFromURL(loadFileUrl)
    MsgBox(loadFilePath)
End If

LibreOffice Calcでセルの行番号/列番号を取得する

Dim startRow As Integer
startRow = ThisComponent.CurrentSelection.RangeAddress.StartRow

Dim endRow As Integer 'endRowは2になる
endRow = ThisComponent.Sheets.getByIndex(0).getCellRangeByName("A1:A3").RangeAddress.EndRow

Dim startColumn As Integer 'startColumnは1になる
startColumn = ThisComponent.Sheets.getByName("sheet1").getCellRangeByName("B1:C6").RangeAddress.StartColumn

Dim endColumn As Integer 'endColumnは3になる
endColumn = ThisComponent.Sheets.getByName("sheet2").getCellRangeByName("A1:D9").RangeAddress.EndColumn

ADODBでデータベースに接続する(Windows限定)

Dim connection As Object
Dim recordset As Object
Dim command As Object
connection = CreateObject("ADODB.Connection")
recordset = CreateObject("ADODB.Recordset")
command = CreateObject("ADODB.Command")

'SQLServerに接続してみる
connection.Open "Provider=SQLOLEDB;Data Source=DB_SERVER\SQLEXPRESS;Initial Catalog=DB_NAME;User ID=sa;Password=123456;"

command.ActiveConnection = connection
command.CommandTimeout = 0
command.CommandText = "SELECT * FROM TABLE_NAME;"
recordset = command.Execute

If recordset.RecordCount > 0 Then
    If recordset.Eof = false Then
       recordset.MoveFirst
     MsgBox(recordset.Fields.Item("field1").Value)
       'MsgBox(recordset.Fields.Item("field1").Name) ←これは使えない
 End If
End if

ディレクトリ選択ダイアログを表示する

Dim folderPicker As Object
Dim isAccept As Integer
Dim folders()
Dim folderUrl as String
Dim folderName as String
folderPicker = createUnoService("com.sun.star.ui.dialogs.FolderPicker")
folderPicker.setTitle ("ディレクトリの選択")
folderPicker.setDescription("ディレクトリを選択してください。")
folderPicker.setDisplayDirectory("C:\Users\Test\Desktop")
isAccept = folderPicker.execute()
If isAccept = 1 Then
    folders() = folderPicker.getDirectory()
    folderUrl = folders(0)
    folderName = ConvertFromURL(folderUrl)
    MsgBox(folderName)
Else
    folderPicker.cancel()
End If