SAK 図書館
SAK 図書館
VB テクニック編26 - oo4o Excel エクスポート、oo4o Excel インポート
■SAK 関数利用規程
・テクニック編で紹介する関数は、私こと Y.SAK の開発関数である。
・著作権明示部分の改編は認めない。
・個人、企業がこれらの関数を使用したり、一部を使用して新たなシステムや
プログラムを開発することは自由です。
・但し、これらの関数を一部でも使用しているソフトウェアをシェアウェア、
その他有償プロダクトとして配布・販売するには、私の許可が必要です。
(無償のフリーソフトウェアなら、自由に配布しても良い。)
・これらの関数を使用して発生した、いかなる形での損害も私こと Y.SAK は
賠償しません。
■Excel シートエクスポート (oo4o 版)
・外部データコンバートとして、Excel シートに問い合わせ結果を出力には、
次のようにする。但し、コードのゼロ埋め処理はしていません。
見出し出力が不要な場合は、mds = false にする。
Dim OraSession as variant
Dim OraDatabase as variant
Dim dbname as string
Dim cnuser as string
Dim sql As String
Dim rs As variant
Dim fnm As String
Dim mds As boolean
Dim i As Integer
Dim k As long
Dim exl As Object
dbname = ""
cnuser = "SAK/SAK"
sql = "select * from sak.受注m order by 受注番号"
fnm = "g:\tmp\test.xls"
mds = true
Set OraSession = CreateObject("OracleInProcServer.XOraSession")
Set OraDatabase = OraSession.OpenDatabase(dbname, cnuser, 0)
set rs = OraDatabase.CreateDynaset(sql, 0)
Set exl = CreateObject("Excel.Sheet")
k = 1
if mds then
For i = 0 to rs.fields.count - 1
exl.worksheets(1).cells(k, i + 1).value = rs(i).name
Next
k = 2
end if
Do Until rs.EOF
For i = 0 to rs.fields.count - 1
if rs(i).type <> 4 then
exl.worksheets(1).Cells(k, i + 1).NumberFormatLocal = "@"
end if
exl.worksheets(1).cells(k, i + 1).Value = rs(i).Value & ""
Next
k = k + 1
rs.MoveNext
Loop
Set rs = Nothing
exl.Sheets(1).Name = "test"
exl.Application.Visible = True
exl.Windows.Arrange ArrangeStyle:=1
exl.saveas fnm
Set OraDatabase = Nothing
Set OraSession = Nothing
■Excel シートインポート (oo4o 版)
・外部データ取込として、Excel シート上のデータをデータベースに追加更新
するには、次のようにする。
先頭行を見出しとして無視するか指定できる。
見出しがない場合は、mds = false にする。
テーブルの項目に、char、varchar2、number、long 以外があると、文字列
と数値の判断がおかしくなるかもしれません。
見出しによって、テーブル項目を指定することはしていないので、
シートの項目順は、更新テーブルの項目順と一致していなければなりません。
・一括トランザクションをかけているため、大量のレコードを更新しようとす
ると、ロールバックセグメントがオーバーするか、著しく更新速度が低下す
る可能性があります。1 万件を超える場合は要注意です。
Dim OraSession as variant
Dim OraDatabase as variant
Dim dbname as string
Dim cnuser as string
Dim tbl As String
Dim tky As String
Dim sql As String
Dim rs As variant
Dim fnm As String
Dim mds As boolean
Dim fno As Integer
Dim i As Integer
Dim j As Integer
Dim k As long
Dim s As String
Dim ct As long
Dim exl As Object
dbname = ""
cnuser = "SAK/SAK"
tbl = "sak.受注m"
tky = "受注番号 = ''" '0 件のダミー問い合わせ用のキー"
fnm = "g:\tmp\test.xls"
mds = true
Set OraSession = CreateObject("OracleInProcServer.XOraSession")
Set OraDatabase = OraSession.OpenDatabase(dbname, cnuser, 0)
sql = "select * from " & tbl & " where " & tky
set rs = OraDatabase.CreateDynaset(sql, 0)
j = rs.fields.count - 1
redim ctyp(j) as boolean
For i = 0 to j
select case rs(i).type
case 4
ctyp(i) = true
case else
ctyp(i) = false
end select
Next
rs.close
Set exl = CreateObject("Excel.Application")
exl.Application.Visible = True
exl.Application.Workbooks.Open FileName:=fnm
k = 1
if mds then
k = 2
end if
OraSession.BeginTrans
on error resume next
for k = k to 65536
s = ""
If exl.Cells(k, 1) = "" Then Exit For
For i = 0 To j
if ctyp(i) then
s = s & "," & exl.Cells(k, i + 1)
else
s = s & ",'" & exl.Cells(k, i + 1) & "'"
end if
Next
s = mid(s, 2)
sql = "insert into " & tbl & " values (" & s & ")"
OraDatabase.ExecuteSQL sql
if err <> 0 then
OraSession.RollbackTrans
close fno
Set OraDatabase = Nothing
Set OraSession = Nothing
msgbox "更新エラー" & chr(10) & err & ": " & error _
& chr(10) & ct + 1 & " 件目に問題あり" _
& chr(10) & sql
end
end if
ct = ct + 1
next
OraSession.CommitTrans
on error goto 0
exl.Application.DisplayAlerts = False
exl.Application.Quit
Set OraDatabase = Nothing
Set OraSession = Nothing
■VB テクニック編資料
■VB 入門編資料
■VB 基礎編資料
■VB ビジュアル編資料
Copyright (C) 1999-2024 Y.SAK