マクロの中でSQL文を書けば、必要なデータセットを自由に抽出、また更新、追加ができるのだ ー ADODB（VBAマクロ）

             

メーカーであれば、資材所要量計画 (MRP)の基幹システムが動いていますよね。

工場勤務であればなおさらで、生産に携わる仕事なら関連データは欠かせない。

端末装置から日々に必要なデータを入手していますが、追加の仕事も発生する。

まあ、データの加工ができない時には、力任せでデータのダウンロードなんだ。

基本的に、システムはでかい縦横の二次元表で、データが集められていますな。

このデータを夜間計算しながら、日々の生産計画とか、資材発注とか行われる。

基本業務なら、システムの操作で大抵こなせますが、実際は細かい仕事も多い。

それでも、MRPのデータが頼りになるので、CSVファイルを落としてくるわけ。

このCSVファイルはエクセルで簡単に開けますが、必要なデータだけが欲しい。

現在、使っているデータは、四千行、百二列で、セル数が四十万以上になるの。

これも、電算系の人間が、ずぼらにデータを落とせるようにSQLで組んだだけ。

だけど、実際に使いたいのは僅か二列だけなので、ここだけ読み込みたいのだ。

こうなると、VBAでADO(ActiveX Data Objects)のコードを書くしかないなあ。

マイクロソフトの提供するソフトウエア部品で、データベースアクセスが目的。

自分も良く使いますが、今回、目から鱗で理解したのが、ヘッダーの無い事例。

データベースでは、各列のタイトルが一行目に割り当てているのが、普通です。

ところが、MRPアプリケーションからデータを落としたら、ヘッダーが怪しい。

冒頭のキャプチャーのように、ヘッダーが三行になっていて、とんでもないわ。

なので、ヘッダーなしの読み出しで自動で”列番号”を振らせることにしました。

これが分かると、M列、N列は、F13とF14で振られて、この列だけ読み取りだ。

欲しい列のデータだけをブックに読み込ませることができるから、実に便利ね。

特に、ヘッダー部には二百文字以上の項目があって、読み込みを遅くしている。

というわけで、サンプル構文を載せておきますので、ベタにCSVファイルなどを読み込ませずに、必要な列項目のみを読んで加工することで早い処理が可能になると言うのが、分かったのでした。

※サンプル構文

Sub ReadCsv() 'ADODBで ヘッダータイトル無しから列を指定して読み込み

Dim objCn As New ADODB.Connection, objRS As ADODB.Recordset

Dim i As Long, strSQL As String, strFle As String

  ThisWorkbook.Sheets(1).Cells.ClearContents '初めに使徒のセルをクリア

    With objCn  'CSVへのコネクション初期設定

      .Provider = "Microsoft.ACE.OLEDB.12.0"

      .Properties("Extended Properties") = "Text;HDR=NO;FMT=Delimited"

        'HDR=NOは、ヘッダー無し・列タイトルがないと、FでIDが振られる

      .Open "G:\共有DRV\Z9999_生産\ペーパーレス\" '読み込み先指定

   End With

     strSQL = ""      'ここからSQL文作成

       strSQL = strSQL & " SELECT F13, F14"  '列タイトルのF番号IDを利用

         strSQL = strSQL & " FROM ["

           strSQL = strSQL & Fnctn1

           '最新タイムスタンプファイルデータ取得（ファンクションプロシージャ）

             strSQL = strSQL & "] "

                strSQL = strSQL & ""

    Set objRS = New ADODB.Recordset  'SQLを実行しレコードセット取得

       Set objRS = objCn.Execute(strSQL)

         With ThisWorkbook.Worksheets(1)

           .UsedRange.ClearContents   '1行目にF番号の出力

             For i = 0 To objRS.Fields.Count - 1

               .Cells(1, i + 1) = objRS.Fields(i).Name

             Next

        'レコードセットを一括出力(一行目は項目、2行目から出力）

      　     .Range("A2").CopyFromRecordset objRS

         End With '三行のヘッダーも出力されるので、データは五行目から

     objCn.Close

         Set objRS = Nothing

             Set objCn = Nothing

End Sub

'参照設定で、Microsoft ActiveX Data Objects 6.1 Libraryの指定必須

Public Function Fnctn1() '最新のタイムスタンプファイルデータ取得

Dim FileTime As Date, MaxTime As Date

Dim FileName As String, MaxFileName As String

  With CreateObject("WScript.Shell") ''読み込み先カレントフォルダを指定

    .CurrentDirectory = "G:\共有DRV\Z9999_生産\ペーパーレス\"

  End With

    FileName = Dir("*.csv") 'ワイルドカードで拡張子「csv」ファイルを取得

      Do While FileName <> "" 'ファイルを取得出来なくなるまでループ

        FileTime = FileDateTime(FileName) '取得したファイルの日時を取得

          If FileTime > MaxTime Then '時間を比較

            MaxTime = FileTime '日付が大きい場合は格納

              MaxFileName = FileName '日付が大きい場合はファイル名格納

          End If

        FileName = Dir() '最新のタイムスタンプファイルを取得

      Loop

   Fnctn1 = MaxFileName 'プシージャ名でファイル名を渡す

End Function

'MRPシステムでは、フォルダ内に毎日最新データが落とされる仕組みのため

いいねと思ったら、三つポチっとね！
  
にほんブログ村    にほんブログ村      にほんブログ村