Excel VBA質問箱 IV

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

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


2961 / 13646 ツリー ←次へ | 前へ→

【65049】テキストファイルの読込について フェレット 10/4/8(木) 9:05 質問[未読]
【65056】Re:テキストファイルの読込について Jaka 10/4/8(木) 13:03 発言[未読]

【65049】テキストファイルの読込について
質問  フェレット  - 10/4/8(木) 9:05 -

引用なし
パスワード
   あるフォルダ配下のテキストファイルの内容を読み込み、
一つのセルの中に格納しようとしています。
ただ、当然1セルに格納できる文字数は決まっているので、
指定の文字数を超えた場合は、隣のセルに続きの文字列を出力したいとおもっています。
※1行ファイルで、規定文字数を超えた場合は列に

下記のようなマクロを組んだのですが、途中でメモリエラーとなってしまいます。
※Cells(i, j).Value・・・の箇所で。

MsgBoxで表示すると問題ないのですが、どうすれば回避できるか
ご存知の方いましたら教えて頂けないでしょうか。


Private Const C_COUNT As String = "20000"

Sub Macro()
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")

  Dim FolderPath As String
  Dim ShellApp As Object
  Dim oFolder As Object
  
  Set ShellApp = CreateObject("Shell.Application")
  Set oFolder = ShellApp.BrowseForFolder(0, "フォルダ選択", 1)
  FolderPath = oFolder.items.Item.Path

  Dim myFile As Object
  Dim i As Long
  Dim j As Long
  Dim count As Long
  Dim lenm As Long
  
  
  i = 1
  
  For Each myFile In fso.GetFolder(FolderPath).Files
    If Right(myFile, 4) = ".txt" Or Right(myFile, 4) = ".TXT" Then
            
      count = Len(fso.OpenTextFile(myFile.Path).ReadAll())
      If count > C_COUNT Then
        lenm = 1
        For j = 1 To (count / C_COUNT) + 1
          'MsgBox Mid(fso.OpenTextFile(myFile.Path).ReadAll(), lenm, C_COUNT)
          Cells(i, j).Value = Mid(fso.OpenTextFile(myFile.Path).ReadAll(), lenm, C_COUNT)
          lenm = lenm + C_COUNT
        Next
      Else
        Cells(i, 1).Value = fso.OpenTextFile(myFile.Path).ReadAll()
      End If
      
      i = i + 1
    End If
  Next

  If i = 1 Then
    MsgBox "取込対象ファイルが存在しませんでした。"
  Else
    MsgBox "[ " & i - 1 & " ]件取込を実施しました。"
  End If
  
End Sub

【65056】Re:テキストファイルの読込について
発言  Jaka  - 10/4/8(木) 13:03 -

引用なし
パスワード
   ReadAllは、メモリ食いなんで、昨年までのスペックの低いPCで使うと遅くなったり、
フリーズしたりで、使ったことがほとんど全く無いけど。

>      count = Len(fso.OpenTextFile(myFile.Path).ReadAll())
                ↑ここで1回開く。

        ↓この下で同じものを開いて、2度目。しかも、全部開きっぱなし。
>      If count > C_COUNT Then
>        lenm = 1
>        For j = 1 To (count / C_COUNT) + 1
>          'MsgBox Mid(fso.OpenTextFile(myFile.Path).ReadAll(), lenm, C_COUNT)
>          Cells(i, j).Value = Mid(fso.OpenTextFile(myFile.Path).ReadAll(), lenm, C_COUNT)
>          lenm = lenm + C_COUNT
>        Next
>      Else
>        Cells(i, 1).Value = fso.OpenTextFile(myFile.Path).ReadAll()
>      End If

開くのをこんな感じにしてみたら...。

With fso.OpenTextFile(ファイルのフルパス, 1)
   st = .ReadAll
   MsgBox Len(st)
   .Close
End With

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