EXCELのVBAでのCSVファイル読込みと検索

質問

エクセルのマクロでCSVファイルを読み込み、その行の得意先サブコードをキー項目として別のCSVファイルを検索し電話番号とFAX番号を取得するという作業を下記のようなコードで作成しました。

Dim Obj As Object
Dim Path As String
Dim FName As String

Dim i As Long
Dim buf As String
Dim tmp As Variant
Dim WSH As Variant

Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset

'自分のPCのデスクトップをPathとして設定します。
Set WSH = CreateObject("Wscript.Shell")
Path = WSH.SpecialFolders("Desktop") & "\"

'得意先マスタ.csvをOPENする際の準備処理
'3行目のPropertiesがCSVファイルの定義(excelをOPENする時とは異なります)
Set CN = New ADODB.Connection
CN.Provider = "Microsoft.Jet.OLEDB.4.0"
CN.Properties("Extended Properties") = "Text;HDR=YES;FMT=Delimited"
CN.Open Path

'得意先サブマスタ.CSVを開きます。
Open Path & "得意先サブマスタ.csv" For Input As #1

i = 1

Do Until EOF(1)
Line Input #1, buf
tmp = Split(buf, ",")
If i = 1 Then
Else
Cells(j, 1).Value = Left(tmp(3), 4) '会社コード
Cells(j, 2).Value = Right(tmp(3), 4) '店舗コード
Cells(j, 3).Value = tmp(3) '会社＠店舗
Cells(j, 4).Value = tmp(4) '得意先コード
Cells(j, 5).Value = tmp(5) '店舗名

Set RS = New ADODB.Recordset
RS.Open "SELECT * FROM 得意先マスタ.csv WHERE 得意先コード = " & tmp(4) & " ", CN
If RS.EOF Then
Cells(j, 6).Value = "???"
Cells(j, 7).Value = "???"
Else
Cells(j, 6) = RS.Fields("電話番号")
Cells(j, 7) = RS.Fields("FAX番号")
End If
End If
i = i + 1
Loop

このコードで動作確認すると途中で動作が止まってしまい応答なし状態になってしまいます。どこで止まるかは一定ではありません。CSVファイルの内容も確認したのですが、特におかしいような箇所はありませんでした。
OSはWINDOWS７、EXCELは2016です。
コード自体に修正した方がいいような箇所があればアドバイスいただきたいと思っております。宜しくお願い致します。

回答No.1

ushi2015 · ベストアンサー

こんにちは
どうせADOを使うのなら、
Sub test1()
　　Dim CN As ADODB.Connection
　　Dim RS As ADODB.Recordset
　　Dim 最終行 As Long
　　Dim sSql As String
　　Dim i　　 As Long

　　Set CN = New ADODB.Connection

　　With CN
　　　　.Provider = "Microsoft.Jet.OLEDB.4.0"
　　　　.Properties("Extended Properties") = "Text;HDR=Yes;FMT=Delimited;"
　　　　.Open CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\"
　　End With

　　Set RS = New ADODB.Recordset

　　sSql = ""
　　sSql = sSql & "SELECT "
　　sSql = sSql & "LEFT(a.会社＠店舗, 4) AS 会社コード, "
　　sSql = sSql & "RIGHT(a.会社＠店舗, 4) AS 店舗コード, "
　　sSql = sSql & "a.会社＠店舗, "
　　sSql = sSql & "a.得意先コード, "
　　sSql = sSql & "a.店舗名, "
　　sSql = sSql & "b.電話番号, "
　　sSql = sSql & "b.FAX番号 "
　　sSql = sSql & "FROM 得意先サブマスタ.csv AS a "
　　sSql = sSql & "LEFT JOIN "
　　sSql = sSql & "　　 得意先マスタ.csv AS b "
　　sSql = sSql & "ON a.得意先コード = b.得意先コード "

　　RS.Open sSql, CN　　

　　For i = 1 To RS.Fields.Count
　　　　Cells(1, i) = RS.Fields(i - 1).Name
　　Next　　

　　Range("A2").CopyFromRecordset RS　　　　
　　RS.Close

End Sub
のようにしてはどうですか？

お礼

構文として大変参考になりました。どうもありがとうございました。

回答No.2

Prome_Lin

私は、むずかしいことは分かりませんので、もっと、単純化してしまいます。

例えば、「Worksheets(1)」が電話番号などを読み込ませたいシートだとして、あと２つシートを追加しておきます。

そして、「Worksheets(2)」に「得意先マスタ.csv」を読み込ませます。

もちろん、「Worksheets(3)」には「得意先サブマスタ.csv」を読み込みます。

ＶＢＡの例としては、
Sub Test()
Open "D:\Programming\得意先マスタ.csv" For Input As #1
l = 0
Do Until EOF(1)
Line Input #1, a
b = Split(a, ",")
l = l + 1
For i = 0 To UBound(b)
Worksheets(2).Cells(l, i + 1).Value = b(i)
Next i
Loop
Close #1
End Sub

という具合に、「Microsoft」云々のようなややこしい（私にとっては）ものは使いません。

「Worksheets(1)」と「(2)」に「csv」ファイルが読み込めれば、あとは「Find」によって検索をかけて、見つければいいと思います。

もしくは、別のエクセルを起動して、シートを２つ用意し、そのエクセルに「csv」ファイルを読み込ませておいて、「Find」で検索をかける、とすれば、元のエクセルに不要なデータを取り込む必要はありません。

冒頭言いましたように、私には、「ADODB」などの扱いは、難しすぎるので、単純にしたいです。

お礼

おっしゃられている事、よくわかります。
FIND でも VLOOKUP でも実行可能ですよね。
ただ今回はADOの勉強をしたかったので、こういう質問をさせていただきました。
どうもありがとうございました。