| |
たしか、殆どのWindowsのアプリケーションで出力されるTextは、Eof「＆H1A」が付けられないし、
通常使っているOpenステートメントは、「＆H1A」を検出した位置で読み込み終了と成り、
「＆H1A」出力されないので忘れていました
（FsoでTextを読む場合「＆H1A」も通常の文字として読み込む様ですね）
「＆H1A」が出力されるTextの場合（Dosの頃の仕様？）は、其の処理が必要と成ると思います
1つは、かみちゃんさんの様な処理をするか？
若しくは、Openステートメントを使って以下の様にすれば善いと思います
Public Sub CSVRead()
' CSVデータの読み込み
Dim i As Long
Dim rngWrite As Range
Dim lngRow As Long
Dim strPath As String
Dim dfn As Integer
Dim vntFileNames As Variant
Dim vntField As Variant
Dim strBuff As String
Dim objFso As Object
Dim objFileStr As Object
Dim blnHeader As Boolean
Dim strBaseName As String
Dim strProm As String
'書き込む位置を設定
Set rngWrite = ActiveSheet.Cells(1, "A")
'FSOのオブジェクトを取得
Set objFso = CreateObject("Scripting.FileSystemObject")
'読み込むファイルのフォルダを設定
strPath = "C:\Documents and Settings\All Users\デスクトップ\CSVフォルダ"
'指定フォルダからファイル名を取得
strBaseName = "^A[0-9][0-9][0-9][0-9][0-9][0-9]$"
If Not GetFilesList(vntFileNames, strPath, objFso, strBaseName, "csv") Then
strProm = "ファイルが有りません"
GoTo Wayout
End If
Application.ScreenUpdating = False
For i = 1 To UBound(vntFileNames)
'指定ファイルを読み込みモードでOpen
dfn = FreeFile
Open vntFileNames(i) For Input As dfn
Do Until EOF(dfn)
'ファイルから１行読み込み
Line Input #dfn, strBuff
'「blnHeader = True」の場合其の行は書きこまない
If Not blnHeader Then
'CSVをフィールドに分割
vntField = SplitCsv(strBuff, ",")
'指定シートの指定行列位置について
With rngWrite.Offset(lngRow)
'フィールドの書き込み
.Resize(, UBound(vntField) + 1).Value = vntField
End With
'書き込み行位置を更新
lngRow = lngRow + 1
End If
'blnHeaderをFaseにして以降の行を書き込む
blnHeader = False
Loop
'ファイルをClose
Close #dfn
'「blnHeader = True」の場合其の行は書きこまない
blnHeader = True
Next i
strProm = "処理が完了しました"
Wayout:
Application.ScreenUpdating = True
Set objFileStr = Nothing
Set objFso = Nothing
Set rngWrite = Nothing
MsgBox strProm, vbInformation
End Sub
尚、書き忘れましたが、読み込むCsvファイルの名前は、
Aが先頭で且つ、6桁の数字から成るファイル限定ですので気を付けて下さい
また、此れをアルファベット1文字が先頭で、6桁の数字から成るファイルとしたいなら
以下の様にして下さい
'指定フォルダからファイル名を取得
strBaseName = "^A[0-9][0-9][0-9][0-9][0-9][0-9]$"
を
'指定フォルダからファイル名を取得
strBaseName = "^[A-Z][0-9][0-9][0-9][0-9][0-9][0-9]$"
とします
|
|
Hirofumi
- 06/6/3(土) 14:23 -
