LibreOffice のマクロ

以下は、昨日に作成したLibreOffice用（Windows上で動作）のマクロです。

私は、Access2003 は持っていますが、Excel は持っておらず、Excel の代わりにLibreOffice やOpenOfficeの Calc を使用しています。LibreOffice の Calc のデータを、Access のデータベースにコピーするためのマクロです。 Calc ファイルの、2列目、3列目、4列目のデータを、サンプルデータベース.mdb というAccessデータベースのサンプルテーブルにコピーしています。入力するデータは、日付、JANコード、商品名です。同じJANコードのレコードがすでに、Accessデータベース側に存在する場合には、メッセージを出力し、コピーは行われません。

なお、以前にも LibreOffice のマクロでAccessデータベースにレコードを入力するサンプルを紹介させていただいたことはありました。


sub adodb_put_mdb2

    Dim hiduke as String
    Dim jancode as String
    Dim shouhinmei as String
     Dim j as Integer
     Dim kison as Boolean
       
       
    j = inputbox("行数を入れてください","はじめる行数","3")
   
    j = j-1
   

 Set conn = CreateObject("ADODB.Connection")
 Set rs = CreateObject("ADODB.Recordset")
   
   conn.Open "Driver={Microsoft Access Driver (*.mdb)}; DBQ=c:\Users\hiroshi\Dropbox\doc\mdb\サンプルデータベース.mdb"
  
   
    rs.Open "select * from サンプルテーブル", conn ,3,3
'

    do while j < 2000


    hiduke= ThisComponent.Sheets.getByName("3月").getCellByPosition(1,j).string
    jancode= ThisComponent.Sheets.getByName("3月").getCellByPosition(2,j).string
    shouhinmei= ThisComponent.Sheets.getByName("3月").getCellByPosition(3,j).string

    ' msgbox jancode
   
   
    if jancode = "" then
         exit do
    end if
       
   
    rs.Movefirst()
    kison = false
   
    do until rs.EOF
   
   
        'msgbox rs.Fields.Item("JANコード").value
       
        if    jancode = rs.Fields.Item("JANコード").Value then
            msgbox "既にあります。" & jancode & rs.Fields.Item("商品名").value
            kison = true
            '& rs.Fields.Item("日付").value
           
        end if
       
        rs.Movenext()           
    loop

    if kison = false then
   

    rs.AddNew
     rs.Fields.Item("日付").value=hiduke
     rs.Fields.Item("JANコード").value=jancode
     rs.Fields.Item("商品名").value=shouhinmei
     rs.Update

      end if
     
 
  j = j+1
 
  loop
 
    rs.Close
    conn.Close
   
msgbox "end"

end sub