SAK 図書館

SAK Streets メインストリート 図書館・カフェ 一覧 SAK Streets 検索
| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |

VB テクニック編19 - Excel シートインポート、Excel シートエクスポート

■SAK 関数利用規程

  ・テクニック編で紹介する関数は、私こと Y.SAK の開発関数である。
  ・著作権明示部分の改編は認めない。
  ・個人、企業がこれらの関数を使用したり、一部を使用して新たなシステムや
    プログラムを開発することは自由です。
  ・但し、これらの関数を一部でも使用しているソフトウェアをシェアウェア、
    その他有償プロダクトとして配布・販売するには、私の許可が必要です。
    (無償のフリーソフトウェアなら、自由に配布しても良い。)
  ・これらの関数を使用して発生した、いかなる形での損害も私こと Y.SAK は
    賠償しません。

■Excel シートインポート (ADO 版)

  ・外部データ取込として、Excel シート上のデータをデータベースに追加更新
    するには、次のようにする。
    先頭行を見出しとして無視するか指定できる。
    見出しがない場合は、mds = false にする。
    テーブルの項目に、char、varchar2、number、long 以外があると、文字列
    と数値の判断がおかしくなるかもしれません。
    見出しによって、テーブル項目を指定することはしていないので、
    シートの項目順は、更新テーブルの項目順と一致していなければなりません。

  ・一括トランザクションをかけているため、大量のレコードを更新しようとす
    ると、ロールバックセグメントがオーバーするか、著しく更新速度が低下す
    る可能性があります。1 万件を超える場合は要注意です。

  Dim s3cn_ado As variant
  Dim dsn 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

  dsn = "dsn=SAK3_ADO;uid=SAK;pwd=SAK"
  tbl = "sak.受注m"
  tky = "受注番号 = ''"  '0 件のダミー問い合わせ用のキー"
  fnm = "g:\tmp\test.xls"
  mds = true

  set s3cn_ado = CreateObject ("ADODB.Connection")
  s3cn_ado.Open dsn

  sql = "select * from " & tbl & " where " & tky
  set rs = s3cn_ado.Execute(sql)
  j = rs.fields.count - 1
  redim ctyp(j) as boolean
  For i = 0 to j
    select case rs(i).type
      case 131, 139
        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
  s3cn_ado.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 & ")"
    s3cn_ado.Execute sql
    if err <> 0 then
      s3cn_ado.RollbackTrans
      close fno
      s3cn_ado.Close
      msgbox "更新エラー" & chr(10) & err & ": " & error _
        & chr(10) & ct + 1 & " 件目に問題あり" _
        & chr(10) & sql
      end
    end if
    ct = ct + 1
  next
  s3cn_ado.CommitTrans
  on error goto 0

  exl.Application.DisplayAlerts = False
  exl.Application.Quit
  s3cn_ado.Close

■Excel シートエクスポート (ADO 版)

  ・外部データコンバートとして、Excel シートに問い合わせ結果を出力には、
    次のようにする。但し、コードのゼロ埋め処理はしていません。
    見出し出力が不要な場合は、mds = false にする。

  Dim s3cn_ado As variant
  Dim dsn 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

  dsn = "dsn=SAK3_ADO;uid=SAK;pwd=SAK"
  sql = "select * from sak.受注m order by 受注番号"
  fnm = "g:\tmp\test.xls"
  mds = true

  set s3cn_ado = CreateObject ("ADODB.Connection")
  s3cn_ado.Open dsn
  set rs = s3cn_ado.Execute(sql)

  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
      exl.worksheets(1).cells(k, i + 1).value = rs(i) & ""
    Next
    k = k + 1
    rs.MoveNext
  Loop

  rs.close
  exl.Sheets(1).Name = "test"
  exl.Application.Visible = True
  exl.Windows.Arrange ArrangeStyle:=1
  exl.saveas fnm
  s3cn_ado.Close

■VB テクニック編資料
■VB 入門編資料
■VB 基礎編資料
■VB ビジュアル編資料
| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |

SAK Streets メインストリート 図書館・カフェ 一覧 SAK Streets 検索



Copyright (C) 1999-2024 Y.SAK