Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


53930 / 76732 ←次へ | 前へ→

【27608】Re:複数のCSVファイルの読み込み方
回答  Hirofumi  - 05/8/12(金) 18:22 -

引用なし
パスワード
   改行コードがLfの可能性が有るので
此れで、やって見て、Csvファイルは、マクロの有るBookと同じフォルダに有るとしています
拡張子.csvのファイルを全て抜き出し読み込みます
また、読み込む先は、ActiveSheetのA1からとしています

Option Explicit

Public Sub CSVReadFSO()
  
'  CSVデータの読み込み
  
  Const ForReading = 1

  Dim i As Long
  Dim rngWrite As Range
  Dim lngRow As Long
  Dim strPath As String
  Dim vntFileNames As Variant
  Dim vntField As Variant
  Dim strBuff As String
  Dim objFso As Object
  Dim objFileStr As Object
  Dim strProm As String
  
  '書き込む位置を設定
  Set rngWrite = ActiveSheet.Cells(1, "A")
  
  'FSOのオブジェクトを取得
  Set objFso = CreateObject("Scripting.FileSystemObject")
  
  '読み込むファイルのフォルダを設定
  strPath = ThisWorkbook.Path
  '指定フォルダからファイル名を取得
  If Not GetFilesList(vntFileNames, strPath, objFso, "csv", ".*") Then
    strProm = "ファイルが有りません"
    GoTo Wayout
  End If
  
  Application.ScreenUpdating = False
  
  For i = 1 To UBound(vntFileNames)
    '指定ファイルを読み込みモードでOpen
    Set objFileStr = objFso.OpenTextFile(vntFileNames(i), ForReading)
    With objFileStr
      Do Until .AtEndOfStream
        'ファイルから1行読み込み
        strBuff = .ReadLine
        If strBuff <> "" Then
          'CSVをフィールドに分割
          vntField = Split(strBuff, ",")
          '指定シートの指定行列位置について
          With rngWrite.Offset(lngRow)
            'フィールドの書き込み
            .Resize(, UBound(vntField) + 1).Value = vntField
          End With
          '書き込み行位置を更新
          lngRow = lngRow + 1
        End If
      Loop
      'ファイルをClose
      .Close
    End With
  Next i
  
  strProm = "処理が完了しました"
  
Wayout:
  
  Application.ScreenUpdating = True
  
  Set objFileStr = Nothing
  Set objFso = Nothing
  Set rngWrite = Nothing
  
  Beep
  MsgBox strProm
  
End Sub

Private Function GetFilesList(vntFileNames As Variant, _
              strFilePath As String, _
              objFso As Object, _
              Optional strExtePattan As String = ".*", _
              Optional strNamePattan As String = ".*") As Boolean
  
  Dim i As Long
  Dim objFiles As Object
  Dim objFile As Object
  Dim regExten As Object
  Dim regName As Object
  Dim vntRead() As Variant
  Dim strName As String
  
  'フォルダの存在確認
  If Not objFso.FolderExists(strFilePath) Then
    GoTo Wayout
  End If
  
  'regExtenpのオブジェクトを取得(正規表現を作成)
  Set regExten = CreateObject("VBScript.RegExp")
  With regExten
    'パターンを設定
    .Pattern = strExtePattan
    '大文字と小文字を区別しないように設定
    .IgnoreCase = True
  End With
  Set regName = CreateObject("VBScript.RegExp")
  With regName
    'パターンを設定
    .Pattern = strNamePattan
    '大文字と小文字を区別しないように設定
    .IgnoreCase = True
  End With
  
  'フォルダオブジェクトを取得
  Set objFiles = objFso.GetFolder(strFilePath).Files
  
  'ファイルの数が0でなければ
  If objFiles.Count <> 0 Then
    For Each objFile In objFiles
      With objFile
        strName = .Name
        '検索をテスト
        If regExten.Test(objFso.GetExtensionName(strName)) Then
          If regName.Test(objFso.GetBaseName(strName)) Then
            i = i + 1
            ReDim Preserve vntRead(1 To i)
            vntRead(i) = strName
          End If
        End If
      End With
    Next objFile
  End If
  
  Set regExten = Nothing
  Set regName = Nothing
  
  If i <> 0 Then
    ReDim vntFileNames(1 To UBound(vntRead))
    For i = 1 To UBound(vntRead)
      vntFileNames(i) _
          = strFilePath & "\" & vntRead(i)
    Next i
    GetFilesList = True
  End If
  
Wayout:

  'フォルダオブジェクトを破棄
  Set objFiles = Nothing
  Set objFile = Nothing
  
End Function

0 hits

【27582】複数のCSVファイルの読み込み方 R@プログラム初心者 05/8/12(金) 14:34 質問
【27588】Re:複数のCSVファイルの読み込み方 だるま 05/8/12(金) 15:25 回答
【27591】Re:複数のCSVファイルの読み込み方 R@プログラム初心者 05/8/12(金) 15:56 質問
【27594】Re:複数のCSVファイルの読み込み方 だるま 05/8/12(金) 16:13 回答
【27595】Re:複数のCSVファイルの読み込み方 R@プログラム初心者 05/8/12(金) 16:19 質問
【27596】Re:複数のCSVファイルの読み込み方 だるま 05/8/12(金) 16:38 回答
【27597】Re:複数のCSVファイルの読み込み方 だるま 05/8/12(金) 16:49 回答
【27598】Re:複数のCSVファイルの読み込み方 R@プログラム初心者 05/8/12(金) 16:52 質問
【27600】Re:複数のCSVファイルの読み込み方 だるま 05/8/12(金) 17:00 発言
【27599】Re:複数のCSVファイルの読み込み方 Hirofumi 05/8/12(金) 16:57 発言
【27601】Re:複数のCSVファイルの読み込み方 R@プログラム初心者 05/8/12(金) 17:07 質問
【27603】Re:複数のCSVファイルの読み込み方 だるま 05/8/12(金) 17:12 回答
【27604】Re:複数のCSVファイルの読み込み方 Hirofumi 05/8/12(金) 17:19 発言
【27606】Re:複数のCSVファイルの読み込み方 R@プログラム初心者 05/8/12(金) 17:27 質問
【27608】Re:複数のCSVファイルの読み込み方 Hirofumi 05/8/12(金) 18:22 回答
【27610】Re:複数のCSVファイルの読み込み方 だるま 05/8/12(金) 20:25 回答

53930 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free