AccessへのＣＳＶファイルの取り込み

質問

CSVファイルが複数あるのですが、それを取り込んでひとつにまとめたいと思っています。

数が多いので、どうにか簡単に出来る方法はありませんでしょうか。

今は、インポートしたＣＳＶのデータをコピーして貼り付けているので、数が増えてくると大変な手間です。

やはり、プログラムなんかを使わないとだめなのでしょうか。

あるいは、そういうアプリケーションはありますか？
情報をお持ちの方、よろしくお願いします。

回答No.4

noname#22222 · ベストアンサー

s_husky です。

先の回答のMessage関数は、MsgBoxに置き換えて下さい。
まず、関数の使い方を説明します。
関数自体は、使い方さえ知っておれば事足ります。
が、所詮は、プログラマではない素人の考えたものです。
質問者の手で、より洗練して下さい。

====GetFileList()====================================================================

Dim strFileName() AS String

strFileName()=GetFileList("DirName")-------------第2引数はオプショナル
strFileName()=GetFileList("DirName", "*.txt")

====FileRead()====================================================================

Dim strText AS String

Do
　　strText=FileRead("FileName")-------第2引数にTrueをセットしないと次を読み込む
Loop Until strText=""

FileRead関数は、最後に達すると読み込みエラーを起こします。
が、エラーはトラップされており、結果的に静的なファイルオブジェクトが破棄されます。

====FileAppend()====================================================================

Dim isOk As Boolean

isOK=FileAppend("FileName", "aaaaaaaaaaaaa")
isOK=FileAppend("FileName", "")-----静的なファイルオブジェクトを破棄

====================================================================================

新しい標準モジュールに以下の関数をコピペして下さい。
標準モジュールの名前は、<ファイルシステム関数>など適当に付けて下さい。

＊僅か、４、５行で書ける関数がエラートラップで肥大化しています。
＊が、これは、関数の宿命と思って下さい。

Public Function GetFileList(ByVal strDir As String, _
　　　　　　　　　　　　　　Optional strName As String = "*") As String()
On Error GoTo Err_GetFileList
　　 Dim strFiles As String
　　 Dim fso　　　As FileSystemObject
　　 Dim fol　　　As Folder
　　 Dim fil　　　As File
　　 Dim fils　　 As Files

　　 Set fso = New FileSystemObject
　　 Set fol = fso.GetFolder(strDir)
　　 Set fils = fol.Files

　　 For Each fil In fils
　　　　 If fil.Name Like strName And fil.Attributes = Archive Then
　　　　　　 strFiles = strFiles & "," & fil.Name
　　　　 End If
　　 Next
Exit_GetFileList:
On Error Resume Next
　　GetFileList = Split(Mid(strFiles, 2), ",")
　　Exit Function
Err_GetFileList:
　　strFiles = ""
　　MsgBox Err.Description & "(GetFileList)", vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_GetFileList
End Function

Public Function FileRead(ByVal FileName As String, Optional isStop As Boolean = False) As String
On Error GoTo Err_FileRead
　　　　Static isOpen As Boolean
　　　　Static fso　　　　As FileSystemObject
　　　　Static fil　　　　As File
　　　　Static txs　　　　As TextStream

　　　　If Not isOpen Then
　　　　　　　　isOpen = True
　　　　　　　　Set fso = New FileSystemObject
　　　　　　　　Set fil = fso.GetFile(FileName)
　　　　　　　　Set txs = fil.OpenAsTextStream(ForReading, TristateUseDefault)
　　　　End If
　　　　FileRead = txs.ReadLine
Exit_FileRead:
On Error Resume Next
　　　　If Len(FileRead) = 0 Or isStop Then
　　　　　　　　isOpen = False
　　　　　　　　Set txs = Nothing
　　　　　　　　Set fil = Nothing
　　　　　　　　Set fso = Nothing
　　　　End If
　　　　Exit Function
Err_FileRead:
　　　　Resume Exit_FileRead
End Function

Public Function FileAppend(ByVal FileName As String, ByVal Text As String) As Boolean
On Error GoTo Err_FileAppend
　　　　Static isOpen As Boolean
　　　　Static fso　　　　As FileSystemObject
　　　　Static txs　　　　As TextStream

　　　　If Not isOpen Then
　　　　　　　　isOpen = True
　　　　　　　　Set fso = New FileSystemObject
　　　　　　　　Set txs = fso.CreateTextFile(FileName, True)
　　　　End If
　　　　If Len(Text) > 0 Then
　　　　　　　　txs.WriteLine Text
　　　　End If
　　　　FileAppend = True
Exit_FileAppend:
On Error Resume Next
　　　　If Len(Text) = 0 Then
　　　　　　　　isOpen = False
　　　　　　　　Set txs = Nothing
　　　　　　　　Set fso = Nothing
　　　　End If
　　　　Exit Function
Err_FileAppend:
　　　　Resume Exit_FileAppend
End Function

お礼

一度アクセスへいれて試して見たいと思います。

本当にありがとうございます！

回答No.5

nicotinism

原始的な方法です。
前提条件
一つのフォルダ内に目的のCSVファイルがあり、
かつ、そのフォルダ内には他のCSVファイルが存在しない。
かつ、CSVファイル内にはデータのみで、タイトル行などは存在しない。
かつ、CSVファイル内の構造は同一である。
であれば、
コマンドプロンプトで、仮にそのフォルダが、c:\data だとして
type c:\data\*.csv >> c:\all.csv
で一つに統合されます。
Access上でやりたい場合は

sub test()
dim rtnVal as long
if dir("c:\all.csv") <> "" then
　　if msgbox("以前のファイルを消しますよ",vbyesno)=vbno then
　　　　msgbox "中止しました"
　　else
　　　　kill "c:\all.csv"
　　end if
end if

rtnVal = shell(environ("comspec") & " /c type c:\data\*.csv >> c:\all.csv")
end sub

のようなものを作成すれば、実行後暫くすると、
Cドライブ直下に統合されたファイルが出来ると思います。
※コマンドラインオプションは、/c か /K
/K だとコマンドプロンプトのウィンドウが閉じません。こっちの方が良いかも？

後はall.csvのインポート処理が無事に済むのを祈るだけ・・・

回答No.3

noname#22222

s_husky です。

次が、C:\Temp\Temp\に存在する*.csvを合成するコードの全てです。
注意事項は、"C:\Temp\gattai.csv"と別フォルダに合成するファイルを作るように指示することです。
誤って、同一ファイルでテストしたところ永遠に作り続けました。
なお、JでForループを脱出する不可思議な仕掛けがあります。
これは、上述の無限ループを阻止するものです。

全体、僅か３０行にも満たないコードです。
一応、合成テストを数回繰り返して結果を確認しています。

Private Sub コマンド0_Click()
　　'
　　' 絶対に同じフォルダを指定しないこと！！
　　'
　　Const conFROM = "C:\Temp\Temp\"
　　Const conTO = "C:\Temp\gattai.csv"
　　Dim isOK　　　As Boolean
　　Dim I　　　　 As Integer
　　Dim J　　　　 As Integer
　　Dim N　　　　 As Integer
　　Dim filName() As String
　　Dim strText　 As String

　　filName() = GetFileList(conFROM, "*.csv")
　　J = -1
　　N = UBound(filName())
　　For I = 0 To N
　　　　J = J + 1
　　　　If N <= J Then
　　　　　　Do
　　　　　　　　strText = FileRead("C:\Temp\Temp\" & filName(I))
　　　　　　　　If Len(strText) > 0 Then
　　　　　　　　　　isOK = FileAppend(conTO, strText)
　　　　　　　　End If
　　　　　　Loop Until strText = ""
　　　　Else
　　　　　　Exit For
　　　　End If
　　Next I
　　FileAppend conTO, ""
　　Message N + 1 & " 個のファイルを合成しました。"
End Sub

＊なお、

GetFileList()・・・ファイルリストを取得する関数。
FileRead()・・・・・・１行づつファイルを読む込む関数。最後まで読んだら""を戻す。
FileAppend()・・・・１行づつファイルに追加書き込むする関数。""を渡すと閉じる。

という３つの関数は明朝に投稿します。
一度では、ゲッとおもうでしょう。
今回のコードはフォームのコマンドボタンのイベントに！

回答No.2

noname#22222

s_husky です。

1000もある場合は、No1のやり方は不可です。

１、結合したファイルを所定のフォルダに集めます。
２、フォルダのファイル一覧を取得します。
３、ファイルを順次にオープンして１行読んでは１行を統合ファイルに書き出します。

これで、メモリの心配もありません。
結合したいファイル名を書く必要もありません。
多分、2、30行のコードを書く必要があるでしょう。
もちろん、ファイルライブラリの関数が更に増えるでしょう。

これから退勤して犬の散歩をさせて酒を飲みます。
2、30行ですから、酒でも飲みながら書いて投稿します。
その際に、ファイルライブラリ関数の登録要領、それを利用した一挙統合コードを書く場所等も示します。

お礼

s_huskyさんたびたび、ありがとうございます！！

私もついて行くのに時間がかかりそうなので、ご無理はなさらないで下さいね。笑

回答No.1

noname#22222

幾つかの方法があると思います。
が、合成後のチェックが必要と思います。

Private Sub コマンド0_Click()
　　DosCommand "Copy C:\Temp\aaa.csv+C:\Temp\bbb.csv C:\Temp\ccc.csv"
End Sub

このように、DOSコマンドを使えば簡単に合成されます。
が、[aaa.csv] の最後が非改行ですと、[bbb.csv]の先頭とくっつきます。
次のように、一旦、変数に呼び込んで合成すると必要なチェックも可能です。

Private Sub コマンド0_Click()
　　Dim strTexts(10) As String

　　strTexts(0) = FileReadAll("C:\Temp\aaa.csv")
　　strTexts(1) = FileReadAll("C:\Temp\aaa.csv")
　　FileWrite "C:\Temp\ddd.csv", strTexts(0) & strTexts(1)
End Sub

なお、ここで使った関数は次のようです。

Public Function DosCommand(ByVal CommandText As String) As Boolean
　　DosCommand = VBA.Shell(VBA.Environ("COMSPEC") & " /C " & CommandText, 6)
End Function

Public Function FileReadAll(ByVal FileName As String) As String
On Error GoTo Err_FileReadAll
　　 Dim fso As FileSystemObject
　　 Dim fil As File
　　 Dim txs As TextStream

　　 Set fso = New FileSystemObject
　　 Set fil = fso.GetFile(FileName)
　　 Set txs = fil.OpenAsTextStream(ForReading, TristateUseDefault)
　　 FileReadAll = txs.ReadAll
Exit_FileReadAll:
　　 Exit Function
Err_FileReadAll:
　　 MsgBox Err.Description & "(FileReadAll)", vbExclamation, " 関数エラーメッセージ"
　　 Resume Exit_FileReadAll
End Function

Public Function FileWrite(ByVal FileName As String, _
　　　　　　　　　　　　　ByVal Text As String) As Boolean
On Error GoTo Err_FileWrite
　　Dim fso As FileSystemObject
　　Dim txs As TextStream

　　Set fso = New FileSystemObject
　　Set txs = fso.CreateTextFile(FileName, True)
　　txs.Write Text
　　FileWrite = True
Exit_FileWrite:
　　Exit Function
Err_FileWrite:
　　MsgBox Err.Description & "(FileWrite)", vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_FileWrite
End Function

お礼

ありがとうございます。
やはり、プログラムを扱う事になるのですね。
これはモジュールというところに記述すればよいのですかね？どうもよくわかりません。すいません。

あと、この方法だと例えばファイルが1000くらいあった場合、その全てをプログラムに記述しなくてはいけなさそうですよね。