アクセスでテキストデータの取込

質問

アクセスでデータ取込行っているのですが、
テキストデータが2個になったときに
テキストデータを二つ取り込みではなく、
テキストデータを2回取り込んでしまってます。
テキストデータの名前は20080222152953.txt

ＶＢでの取り込みは
strInFName = Dir(TxB04)
strInFPath = strInFDir + strInFName
If MsgBox("ファイルを取込します。 ", vbOKCancel) = vbCancel Then

Exit Sub
End If

ErrFlg = False
myPath = "D:\"
myfilename = Dir(TxB04)

Do Until myfilename = ""
DoCmd.TransferText acImportDelim, , "テーブル名", myPath & strInFName, False
myfilename = Dir()
Loop
という形で行っています。
ご指導宜しくお願い致します。

回答No.2

shimix · ベストアンサー

>DoCmd.TransferText acImportDelim, , "テーブル名", myPath & strInFName, False
>myfilename = Dir()

DoCmd.TransferText に書いているファイル名が「strInFName」ですよね？これは最初にDir(TxB04)でセットしたままでは？これでは myfilename = Dir()の意味がないと思いますけど。

　DoCmd.TransferText acImportDelim, , "テーブル名", myPath & myfilename, False

と書くべきでは？

お礼

返答ありがとうございます＾＾
ただ、これだと同じファイル2回読んでしまいます。
どうしてでしょうか？

補足

返答ありがとうございます
こちらでなりました！！
私の勘違いだったようで＾＾；

回答No.1

noname#140971

ここでは Verify 関数を使っているだけで基本的には質問者と同じです。

改善点１、コード中にパス情報やファイル情報を埋め込むのを中止しています。
改善点2、途中で Exit Sub を使って抜けるというやり方も止めています。

これで、随分と＜目で見たら判るコード＞へ変身したかと思います。

Const conPATH = "C:\Temp\"
Const conIMPORTFILES = "ImportData*.txt"

Private Sub コマンド1_Click()
　　Dim strFileName As String

　　If Verify("ファイルを取込します？") = vbYes Then
　　　　strFileName = Dir(conPATH & conIMPORTFILES)
　　　　Do Until strFileName = ""
　　　　　　DoCmd.TransferText acImportDelim, , "tab1", conPATH & strFileName, False
　　　　　　strFileName = Dir()
　　　　Loop
　　End If
End Sub

Public Function Verify(ByVal Msg As String, _
　　　　　　　　　　　 Optional ByVal DefaultButton As Integer = vbDefaultButton1) As Integer
　　Verify = MsgBox(Msg, vbYesNo + vbQuestion + DefaultButton, " 確認")
End Function

ところで、 Dir() で読み込んだファイル名とTransferTextで指示しているファイル名は同じにしました。
TransferText　で読み込んだファイル名を指示していなかったです。

********************************************************************************

Dir()　を使わない手も・・・。

Private Sub コマンド0_Click()
　　Dim Answer　　 As Integer
　　Dim I　　　　　As Integer
　　Dim N　　　　　As Integer
　　Dim strFiles() As String

　　Answer = Verify("ファイルを取込します？")
　　If Answer = vbYes Then
　　　　strFiles() = GetFileList(conPATH, conIMPORTFILES)
　　　　N = UBound(strFiles())
　　　　For I = 0 To N
　　　　　　DoCmd.TransferText acImportDelim, , "tab1", conPATH & strFiles(I), False
　　　　Next I
　　End If
End Sub

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 Object
　　 Dim fol　　　As Object
　　 Dim fil　　　As Object
　　 Dim fils　　 As Object

　　 Set fso = CreateObject("Scripting.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:

補足

回答ありがとうございます。
　Answer = Verify("ファイルを取込します？")
動かしてみると↑ココでSubまたはFunctionがありませんと出、
動きません、どういうことなんでしょうか？