Excel VBAについてお願いします

質問

Excelにて複数のCSVファイルを読み込んでいます。
現在使用している物は、同フォルダ内にあるcsvファイルをすべて選択しています。
そこで、毎回同じフォルダ内のcsvファイルを選択を自動化にしたいと思っています。
Const MyFol As String = "C:\AAA\AAAA\"などフォルダを固定したいです。

現在使用している物にどのように追加、変更すれば良いでしょうか？ご伝授願います

Sub CSV取り込み()
Dim csvFile As Variant
Dim fIdx As Long
Dim lngTmp As Long
Dim dCell As Range
csvFile = Application.GetOpenFilename(FileFilter:="ＣＳＶファイル,*.csv", MultiSelect:=True)
Select Case TypeName(csvFile)
Case "Variant()"
If Cells(Rows.Count, 1).End(xlUp).Row = 1 Then
lngTmp = 0
Else
lngTmp = 1
End If
For fIdx = 1 To UBound(csvFile)
Set dCell = Cells(Rows.Count, 1).End(xlUp).Offset(lngTmp, 0)
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & csvFile(fIdx), Destination:=dCell)
.TextFileCommaDelimiter = True
.Refresh BackgroundQuery:=False
End With
If lngTmp = 1 Then dCell.EntireRow.Delete
lngTmp = 1
Next
Range("A1").AutoFilter field:=Range("O:O").Column, Criteria1:="=9"
Range("2:" & Rows.Count).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
Range("A1").AutoFilter
Set dCell = Nothing
Case Else
MsgBox "キャンセル、または不正な操作が行われました"
End Select
End Sub

どうか自動読み込みできるようお願いします。

追加で、処理終了ご『処理完了』などのメッセージがあれば、最高です

よろしくお願いします

回答No.4

SI299792 · ベストアンサー

＞一行目のみ項目がはいり2行目以降はDateが読み込まれていました。
意味が解らないのですが。

前は何も考えずに、ただ結合するだけのプログラムを作ってしまいました。
プルグラムをよくみると、2つ目以降のファイルは、１行目を削除しています（多分ヘッダーでしょう）また、Ｏ列が９のものを削除しています。この機能を追加しました。
'
Option Explicit
'
Sub CSV取り込み()
'
　　Const MyFol As String = "C:\Users\MA\Desktop\My Documents\質問解答\OKWAVE"
　　Dim csvFile As String
　　Dim lngTmp As Integer
　　Dim dCell As Range
'
　　ChDrive MyFol
　　ChDir MyFol
　　Cells.ClearContents
　　lngTmp = 0
　　csvFile = Dir("*.csv")
'
　　While csvFile > ""
　　　　Set dCell = Cells(Rows.Count, "A").End(xlUp).Offset(lngTmp, 0)
　　　　With ActiveSheet.QueryTables.Add _
　　　　　　(Connection:="TEXT;" & csvFile, Destination:=dCell)
　　　　　　.TextFileCommaDelimiter = True
　　　　　　.Refresh BackgroundQuery:=False
　　　　End With
'
　　　　If lngTmp = 1 Then
　　　　　　dCell.EntireRow.Delete
　　　　End If
　　　　lngTmp = 1
　　　　csvFile = Dir
　　Wend
　　Range("A1").AutoFilter field:=Range("O:O").Column, Criteria1:="=9"
　　Range("2:" & Rows.Count).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
　　Range("A1").AutoFilter
　　MsgBox "処理完了"
End Sub

人のプログラムを見て解析するのは大変なんです。文章でもどうなって欲しいか書いて欲しいです。
これでだめなら、サンプルデータと、どうなってほしいという結果を、あげていただけませんか。

お礼

SI299792 様
回答ありがとうございました。
どうしたいのか内容が伝わらない言葉足らずですいませんでした。
ですが、私の思い通りのVBAになっています。
本当にありがとうございました。

回答No.3

imogasi

https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1033916180など見ればわかる。ここは、Googleで「同一フォルダーのCSVファイルを処理」で検索したら出てきた。もっとGoogle照会など、活用するべし。
ーー
要点は、ベストアンサーの中の、
＞For Each FL In FLS ' コレクションを構成するファイルをひとつずつ処理
にある。
ファイルやフォルダの処理には、VBSCRIPTに勉強を広げることを勧める。

回答No.2

SI299792

'
Option Explicit
'
Sub CSV取り込み()
'
　　Const MyFol As String = "C:\Users\MA\Desktop\My Documents\質問解答\OKWAVE"
　　Dim csvFile As String
　　Dim lngTmp As Integer
　　Dim dCell As Range
'
　　ChDrive MyFol
　　ChDir MyFol
　　Cells.ClearContents
　　lngTmp = 0
　　csvFile = Dir("*.csv")
'
　　While csvFile > ""
　　　　Set dCell = Cells(Rows.Count, "A").End(xlUp).Offset(lngTmp, 0)
　　　　With ActiveSheet.QueryTables.Add _
　　　　　　(Connection:="TEXT;" & csvFile, Destination:=dCell)
　　　　　　.TextFileCommaDelimiter = True
　　　　　　.Refresh BackgroundQuery:=False
　　　　End With
　　　　lngTmp = 1
　　　　csvFile = Dir
　　Wend
　　MsgBox "処理完了"
End Sub

なお、OKWAVEは勝手に回答を改ざんします。この回答も改ざんされて、プログラムが動かなくなる可能性があります。

補足

回答ありがとうございます。
ファイルを選択なしで読み込む事ができました。
ですが、使用していた物は各CSVファイルは2行になっていて（項目、Date）一行目のみ項目がはいり2行目以降はDateが読み込まれていました。
なんとか今までの処理内容の自動ファイル読み込みとはならないでしょうか？
よろしくお願いします。

回答No.1

f272

> Const MyFol As String = "C:\AAA\AAAA\"などフォルダを固定したいです。

csvFile = Application.GetOpenFilename
の前に
ChDrive "C" 'もし必要なら
ChDir MyFol
としておけばいかがでしょう。

> 追加で、処理終了ご『処理完了』などのメッセージがあれば、最高です

例えば
Set dCell = Nothing
の後に
MsgBox "処理完了"
としておけばいかがでしょう。