| |
あるフォルダ配下のテキストファイルの内容を読み込み、
一つのセルの中に格納しようとしています。
ただ、当然１セルに格納できる文字数は決まっているので、
指定の文字数を超えた場合は、隣のセルに続きの文字列を出力したいとおもっています。
※１行ファイルで、規定文字数を超えた場合は列に
下記のようなマクロを組んだのですが、途中でメモリエラーとなってしまいます。
※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
|
|
フェレット
- 10/4/8(木) 9:05 -
