Access インポート時にファイル名を追加したい

質問

Access2007のVBAで、あるフォルダ内の全CSVをインポートしたくて、次のページを参考にして、標準モジュールを組みました。
　そして、あるフォルダ内全CSVのインポートには成功しました。
　その時、全CSVはテーブル「Import_Table」にインポートされます。そこで、インポート時に元のCSVのファイル名をインポート先のテーブルの最後のフィールドに追加することはできるでしょうか？

もし、知っておられる方がいたら、教えてください。
お願いします。

http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1226480442

_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/

Sub ImpCSV()
Dim objFs As Object
Dim objFld As Object
Dim objFl As Object

Const cnsFILEPATH = "C:\Documents and Settings\hoge\デスクトップ\hogehoge" 'フォルダー名
Const cnsTABENAME = "Import_Table"

Set objFs = CreateObject("Scripting.FileSystemObject")
Set objFld = objFs.GetFolder(cnsFILEPATH)
For Each objFl In objFld.files
If Right(objFl.Name, 4) = ".csv" Then
DoCmd.TransferText TransferType:=acImportDelim,"インポート定義",tablename:=cnsTABENAME, _
filename:=cnsFILEPATH & "\" & objFl.Name, hasfieldnames:=False
End If
Next

Set objFl = Nothing
Set objFld = Nothing
Set objFs = Nothing
End Sub

/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/

回答No.4

piroin654

#2の

Sub cmdRightFileName(strFile As String)

のところで、

For i = i - 1 To 0

を

For i = i - 1 To 0 Step -1

にしてください。Step - 1　が抜けていました。

回答No.3

mitarashi

インポートもADOで、全部自前でやるのはどうでしょうか。エラー処理はしておりません。
一部のフィールドのみ読み込むといった場合は、recordsetへの書き込み部分を修正する必要があります。
ご参考まで。

Sub ImpCSV()
Const cnsFILEPATH As String = "C:\Documents and Settings\hoge"
Const cnsTABENAME As String = "Import_Table"

Dim objFs As Object
Dim objFld As Object
Dim objFl As Object
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim buf As Variant
Dim i As Long

Set objFs = CreateObject("Scripting.FileSystemObject")
Set objFld = objFs.GetFolder(cnsFILEPATH)
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.Open cnsTABENAME, cn, adOpenKeyset, adLockOptimistic
For Each objFl In objFld.files
If Right(objFl.Name, 4) = ".csv" Then
With objFs.GetFile(cnsFILEPATH & "\" & objFl.Name).OpenAsTextStream
Do
buf = Split(.ReadLine, ",")
rs.AddNew
For i = 0 To UBound(buf)
rs.Fields(i) = buf(i)
Next i
rs.Fields(rs.Fields.Count - 1) = objFl.Name
rs.Update
Loop Until .AtEndOfStream
.Close
End With
End If
Next
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing
Set objFl = Nothing
Set objFld = Nothing
Set objFs = Nothing
End Sub

回答No.2

piroin654

「最後のフィールド」の解釈が微妙でした。
たぶん、以下であろうと思いますが。

各レコードで、データが埋まっているフィールドの
数は不定であるが、かならず各レコードの一番右端、
すなわち「最後のフィールド」は確保されている、
ということであれば、

Sub cmdFileName(strFile As String)
Dim db As Database
Dim rs As Recordset
Dim fld As Field
Dim i As Long

Set db = CurrentDb
Set rs = db.OpenRecordset("Import_Table")

If rs.RecordCount > 0 Then
'最新のレコードに移動
rs.MoveLast
i = rs.Fields.Count
'フィールドが埋まっていない最初のフィールドを左から検索
For i = 0 To i - 1
If IsNull(rs.Fields(i).Value) Then
'見つかったらファイル名を記入
rs.Edit
rs.Fields(i).Value = strFile
rs.Update
Exit For
End If
Next i
Else
MsgBox("レコードがありません")
End If
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing
End Sub

一応、途中で空欄のフィールドが紛れ込んで
いないものとします。紛れ込んでいたら
そこに入れてしまいます。その可能性は
ありますか。あるのならば、以下。
一応、プロシージャ名を変えています。

Sub cmdRightFileName(strFile As String)
Dim db As Database
Dim rs As Recordset
Dim fld As Field
Dim i As Long

Set db = CurrentDb
Set rs = db.OpenRecordset("Import_Table")

If rs.RecordCount > 0 Then
'最新のレコードに移動
rs.MoveLast
i = rs.Fields.Count
'フィールドが埋まっている最初のフィールドを右から検索
For i = i - 1 To 0
If Not IsNull(rs.Fields(i).Value) Then
'見つかったら一つ右のフィールドにファイル名を記入
rs.Edit
rs.Fields(i + 1).Value = strFile
rs.Update
Exit For
End If
Next i
Else
MsgBox ("レコードが有りません")
End If
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing
End Sub

回答No.1

piroin654

以下でどうですか。
DAOを使っているので参照設定でDAOにチェックをいれてください。

Sub cmdFileName(strFile As String)
Dim db As Database
Dim rs As Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("Import_Table")

If rs.RecordCount > 0 Then
rs.MoveLast
If IsNull(rs![最後のフィールド名]) Then
rs.Edit
rs![最後のフィールド名] = strFile
rs.Update
Else
MsgBox ("先客有り")
End If
End If
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing
End Sub

つづいて、Sub ImpCSV()　の、
filename:=cnsFILEPATH & "\" & objFl.Name, hasfieldnames:=False
End If
ところで、

filename:=cnsFILEPATH & "\" & objFl.Name, hasfieldnames:=False
Call cmdFileName(objFl.Name)
End If

のようなものでどうですか。

お礼

>>piroin654さん

回答ありがとうございます。
返事が遅くなって申し訳ありません。
piroin654さんのおっしゃる通り自分で下のように試してみました。
結果は、一部はできたけど一部はできなかったです。
例えば、
[hoge1.csc]
1,2
3,4

[hoge2.csv]
5,6
7

の２つのＣＳＶをインポートすると、
[先客あり]と表示されて、4の１つ右のフィールドには[hoge1.csc]、7の２つ右には[hoge2.csv]と入力されました。
やりたかった「それぞれのレコード右側にインポートファイル名が入力される」ものにはもうちょっとでした。

入力した標準モジュールは、下になります。
インポート定義YYYYではインポートファイル名格納用にtesu4という空のフィールドを用意しています。
個人的には、「Sub cmdFileName」で「rs.MoveLast」というステートメントがあるから、ファイルの一番最後のレコードだけインポートファイル名が入力されるのかなと考えて、「MoveNext」「MoveFirst」を試したりしましたが、どれもうまくいきませんでした。
/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
Sub ImpCSV()
Dim objFs As Object
Dim objFld As Object
Dim objFl As Object

Const cnsFILEPATH = "C:\Documents and Settings\XXXX\デスクトップ\hoge" 'インポートフォルダー名
Const cnsTABENAME = "Import_Table" 'インポート先テーブル名

Set objFs = CreateObject("Scripting.FileSystemObject")
Set objFld = objFs.GetFolder(cnsFILEPATH)
For Each objFl In objFld.files
If Right(objFl.Name, 4) = ".csv" Then 'インポート拡張子
DoCmd.TransferText TransferType:=acImportDelim, SpecificationName:="インポート定義YYYY", tablename:=cnsTABENAME, _
FileName:=cnsFILEPATH & "\" & objFl.Name, hasfieldnames:=False
Call cmdFileName(objFl.Name)
End If
Next

Set objFl = Nothing
Set objFld = Nothing
Set objFs = Nothing
End Sub

Sub cmdFileName(strFile As String)
Dim db As Database
Dim rs As Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("Import_Table") 'インポートテーブル名

If rs.RecordCount > 0 Then
rs.MoveLast
If IsNull(rs!tesu4) Then 'インポートファイル名格納フィールド
rs.Edit
rs!tesu4 = strFile 'インポートファイル名格納フィールド
rs.Update
Else
MsgBox ("先客有り")
End If
End If
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing
End Sub

/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/