レッスン-投稿一覧パソコン仕事５倍塾ポータル

投稿/コメントを表示します。

エクセルVBA外部連携講座

田中宏明さんの投稿

(投稿ID: 4530)

基幹システムから出力されるデータ（CSVファイル形式）が100万行を大幅に超過することになり、Excelで処理できない問題に直面しました。そこで、挫折していたデータベースに再チャレンジしました。
SQLを使い、データを絞り込んで取得できる見通しが立ちました。（うまく動作したとき、あまりの感激に手が震えました。）
以下はCSVファイル形式のデータに対応するよう見直したコードです。

Sub ADO_UseSql_CsvRead1()
    Dim conn As New ADODB.Connection
    Dim rcds As New ADODB.Recordset
    Dim fld As ADODB.Field
    Dim prov As String
'以下は条件付きコンパイル
#If Win64 Then
    prov = "Provider=Microsoft.ACE.OLEDB.12.0;" '64bit
#Else
    prov = "Provider=Microsoft.Jet.OLEDB.4.0;"  '32bit
#End If
    Dim EXProperties As String
    Dim dbpath As String
    Dim mySQL As String
    Dim toSh As Worksheet
    Dim openFilename As Variant
    openFilename = Application.GetOpenFilename("ブック(*.csv),*.csv")
    If VarType(openFilename) = vbBoolean Then Exit Sub

    'ヘッダー付のCSVファイル
    EXProperties = """Text;HDR=Yes;FMT=Delimited"""
    
    'CSVファイルが保存されているフォルダパスを接続先に指定
    dbpath = "Data Source=" & Left(openFilename, InStrRev(openFilename, "\")) _
        & ";Extended Properties=" & EXProperties

    conn.ConnectionString = prov & dbpath
    conn.Open
    
    'FROMでCSVファイル名を指定
    mySQL = "SELECT * FROM " & Mid(openFilename, InStrRev(openFilename, "\") + 1) _
        & " WHERE 郵便番号='158-0094'"
    
    rcds.Open mySQL, conn
    
    Set toSh = ThisWorkbook.Worksheets("CSVデータ取込み")
    toSh.Range("A3").CurrentRegion.ClearContents
    
    Dim c As Long
    c = 0
    For Each fld In rcds.Fields
        toSh.Range("A3").Offset(, c).Value = fld.Name
        c = c + 1
    Next fld
    toSh.Range("A4").CopyFromRecordset rcds

    rcds.Close
    conn.Close
    
    Set rcds = Nothing
    Set conn = Nothing
End Sub

2019/07/22 19:48