Excel シートインポート、Excel シートエクスポート

■SAK 関数利用規程   ・テクニック編で紹介する関数は、私こと Y.SAK の開発関数である。   ・著作権明示部分の改編は認めない。   ・個人、企業がこれらの関数を使用したり、一部を使用して新たなシステムや     プログラムを開発することは自由です。   ・但し、これらの関数を一部でも使用しているソフトウェアをシェアウェア、     その他有償プロダクトとして配布・販売するには、私の許可が必要です。     (無償のフリーソフトウェアなら、自由に配布しても良い。)   ・これらの関数を使用して発生した、いかなる形での損害も私こと Y.SAK は     賠償しません。 ■Excel シートインポート (ADO 版)   ・外部データ取込として、Excel シート上のデータをデータベースに追加更新     するには、次のようにする。     先頭行を見出しとして無視するか指定できる。     見出しがない場合は、mds = false にする。     テーブルの項目に、char、varchar2、number、long 以外があると、文字列     と数値の判断がおかしくなるかもしれません。     見出しによって、テーブル項目を指定することはしていないので、     シートの項目順は、更新テーブルの項目順と一致していなければなりません。   ・一括トランザクションをかけているため、大量のレコードを更新しようとす     ると、ロールバックセグメントがオーバーするか、著しく更新速度が低下す     る可能性があります。1 万件を超える場合は要注意です。   ・RDO、ADO、oo4o、CSV、Excel 各種インポート、エクスポートについては、     http://hpcgi2.nifty.com/sak/s3sh/w_s3shix.cgi?key=インポート%20エクスポート     を参照下さい。   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 にする。   ・RDO、ADO、oo4o、CSV、Excel 各種インポート、エクスポートについては、     http://hpcgi2.nifty.com/sak/s3sh/w_s3shix.cgi?key=インポート%20エクスポート     を参照下さい。   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