こんにちは。
これは、キーワードを見つけたら、その次のキーワードの直前までをインポートします。
.BrowseForFolder(0, "フォルダを選んだください。", 0, 5)
と、5を入れることによって、My Documents フォルダになります。
If InStr(1, LineBuf, KEYWORD, vbBinaryCompare) >
キーワードの文字比較は、BynaryCompare ですから、全角、半角、大文字、小文字を区別しますが、もし、その部分を、一緒にするには、vbTextCompare モードというものがあります。
なお、.csv ファイルは、現在は、あくまでも、「,(コンマ切り）」のみの対応です。
Sub ImportCSV()
Dim myShell As Object
Dim myFol As String
Dim Fn As String
Dim Fno As Integer
Dim LineBuf As String
Dim ArBuf As Variant
Dim EndCol As Integer
Dim n As Long
Dim k As Long
Dim flgKey As Integer
'キーワード
Const KEYWORD As String = "Ａ１"
Set myShell = CreateObject("Shell.Application") _
.BrowseForFolder(0, "フォルダを選んだください。", 0, 0) '最後の0を 5にすると、My Documents
If myShell Is Nothing Then Exit Sub
With myShell
If .Self.Path = "" Then Exit Sub
myFol = .Self.Path & "\"
If MsgBox(myFol & vbCrLf & "上記フォルダを処理します。よろしいですか？", vbInformation + vbOKCancel) = vbCancel Then
Exit Sub
End If
End With
'シートのチェック
On Error Resume Next
Application.Goto Worksheets("TTL").Range("A1")
If Err.Number = 0 Then
If MsgBox("既に、'TTL' シートは存在しています。" & vbCrLf _
& "シートのデータを削除しますか？", vbInformation + vbOKCancel) = vbCancel Then
Exit Sub
Else
ActiveSheet.Cells.Clear
End If
Err.Clear
Else
Worksheets.Add
ActiveSheet.Name = "TTL"
End If
On Error GoTo 0
'インポート
Application.ScreenUpdating = False
With ActiveSheet
Fn = Dir(myFol & "*.csv") 'ワイルドカード
n = 1
Do Until Len(Fn) = 0
Fno = FreeFile
Open Fn For Input As #Fno
flgKey = 0
Do While Not EOF(Fno)
Line Input #Fno, LineBuf
If InStr(1, LineBuf, KEYWORD, vbBinaryCompare) > 0 And flgKey = 0 Then
flgKey = 1
ElseIf InStr(1, LineBuf, KEYWORD, vbBinaryCompare) > 0 And flgKey = 1 Then
flgKey = 2
End If
If flgKey = 1 Then
ArBuf = Split(LineBuf, ",")
EndCol = UBound(ArBuf)
k = k + 1
'2列目に出力
ActiveSheet.Cells(k, 2).Resize(, EndCol) = ArBuf
ElseIf flgKey = 2 Then
Exit Do
End If
Loop
If k > n Then
'ファイル名の書き出し
.Range("A" & n).Resize(k - n + 1).Value = Fn
n = k + 1
End If
Fn = Dir()
Loop
End With
Application.ScreenUpdating = True
End Sub
お礼
ご対応ありがとうございました。 これからどんどん改良していきたいと思います。accessの便利さに今ちょっと感動しています。 この問い合わせを完了させて頂きます。 ありがとうございました。