エクセルVBAで1行単位のデータをテキストファイルに保存時エラーが出ます

1行単位のデータをテキストファイルに保存時エラーが出ます

1行単位のデータをテキストファイルに保存するマクロ
参考：https://oshiete.goo.ne.jp/qa/1376646.html
********************************************************
Sub ColumnOut2Text()
Dim i As Long
Dim j As Long
Dim Fno As Integer
Dim OutColumn As String
'ユーザー設定
　 Const myPath As String = "C:\ZZZ\"
　'かならず、最後に\ を入れてください。
'
With Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
　Fno = FreeFile()
　Open myPath & .Cells(i, 1).Value & ".txt" For Output As #Fno
　For j = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
　　OutColumn = .Cells(1, j).Value & Chr(13) & .Cells(i, j).Value & Chr(13)
　 Print #Fno, OutColumn
　Next j
　OutColumn = Empty
　Close #Fno
Next i
End With
　Beep
End Sub
********************************************************
【データー状況】
1.全データー行数千行：Worksheets("data")
2.テキストファイル出力用シート：Worksheets("test")作成　＊マクロも修正
　・1列目　タイトル等複数列
　・2行目以降データー(全データーから適当行をコピー）
　・「保存用シート」の行及び列にブランクセルなし　＊コピー貼付けの為、毎回確認

【エラー状況】
＊データー出力が出来た時も以前あった時
1.データー出力ファイル数（200行セット）が数十行しか作れない
＊FreeFile()　をFreeFile(0)、FreeFile(1)に変更とかもしてみる
2.その後再度、マクロ実行すると「エラー 76」となる

＊初めからエラーの時
1.エラー 76 「パスが見つかりません。」となる
2.マクロのOpen ステートメントの前に
Shell "C:\Windows\Explorer.exe " & myPath, vbNormalFocus
で確認すると、マクロのデーター保存パスのフォルダーは開く

【改善したい事】
1.エラー 76 「パスが見つかりません。」の解決
2.数千行あるときに、随時連続(行数はいくらでもよい)してテキストファイルに出力したい
3.その他のテキスト出力方法のマクロ(数千行を出力：随時連続出力でも可能)


こちらの環境は、「windows10」「Excel2007」です。
よろしくお願いいたします。

質問者からの補足コメント

• 回答をいただいて上のさらなる質問なんですが
  ご指摘のあった
  果たして、A列の名前が、ファイル名にふさわしいかどうかにもよります。
  使えない文字が入っていたり、あまりに長すぎたりしたら、ファイル名に使えません。
  ↑↑↑
  ファイル名に使える文字と文字数を同時チェックすることは可能でしょうか。
  又、どのような文字がエラーになるのでしょうか。

  No.1の回答に寄せられた補足コメントです。 補足日時：2017/05/12 08:25

No.1 回答者： WindFaller 回答日時： 2017/05/11 21:03

元の質問と、ご質問者さんの質問とは内容が違うのではないでしょうか？

似ていても、その範疇にはないものもあるはずです。

まず、テキストファイルのファイル名をどうするのか、ということです。
数千行を出力するのだとしても、A0001.txt, A0002.txt ... のようにしなくてはなりません。

元の質問者のように、自分は出力してほしい、ということをおっしゃられたほうが話が早いような気がします。

パスが見つからないというのは、
myPath & .Cells(i, 1).Value & ".txt"

果たして、A列の名前が、ファイル名にふさわしいかどうかにもよります。
使えない文字が入っていたり、あまりに長すぎたりしたら、ファイル名に使えません。

ファィル名は、こちらの任意で作りました。
'//
Sub LinesOut2Text()
　Dim i As Long
　Dim j As Long
　Dim Fno As Integer
　Dim init As String, initn As String
　Dim cnt As Long
　Dim buf As String, tmp As String
　Dim fn As String, c As Variant
　'ユーザー設定
　Const myPath As String = "C:\ZZZ\"

　'かならず、最後に\ を入れてください。　'
　'ファイル名の最初
　init = "A"
　cnt = 0　'ファイル名の数字部分

　If Dir(myPath & init & "*.txt") <> "" Then
　　Do
　　　j = j + 1
　　　tmp = Columns(j).Address(0, 0)
　　　init = Left(tmp, InStr(1, tmp, ":") - 1)
　　　fn = Dir(myPath & init & "*.txt")
　　Loop Until fn = ""
　End If
　With ActiveSheet
　　For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
　　　If Application.CountA(.Range(.Cells(i, 1), .Cells(i, Columns.Count).End(xlToLeft))) > 0 Then
　　　　Fno = FreeFile()
　　　　cnt = cnt + 1
　　　　Open myPath & init & Format(cnt, "0000") & ".txt" For Output As #Fno
　　　　For Each c In .Range(.Cells(i, 1), .Cells(i, Columns.Count).End(xlToLeft))
　　　　　If c.Value <> "" Then
　　　　　　If buf = "" Then
　　　　　　　buf = c.Value
　　　　　　Else
　　　　　　　buf = buf & " " & c.Value
　　　　　　End If
　　　　　End If
　　　　Next
　　　　Print #Fno, buf
　　　　Close #Fno
　　　　buf = ""
　　　End If
　　Next i
　End With
　If cnt > 0 Then
　　MsgBox init & " " & cnt & "行出力しました。", vbInformation
　End If
End Sub

この回答へのお礼

お世話になります
「1行単位のデータをテキストファイルに保存するマクロ」を参考にした部分は、
1.テキストファイル名を、セルに入力されている文字を使って保存
　　myPath & .Cells(i, 1).Value & ".txt"←ここでセルの文字でファイル名を作るというところです

ご指摘の
まず、テキストファイルのファイル名をどうするのか、ということです。
数千行を出力するのだとしても、A0001.txt, A0002.txt ... のようにしなくてはなりません。
↑↑↑
このようなファイル名で保存したくないのです。

2.また、見出し行のセル名「x」で改行してデーター「a1」で保存
x
a1

y
a2

z
a3
と見出し行で改行してデーターとしているところです。

Sub LinesOut2Text()
ではそこのところが・・・

3.ファイル名・文字数について
ご指摘の
果たして、A列の名前が、ファイル名にふさわしいかどうかにもよります。
使えない文字が入っていたり、あまりに長すぎたりしたら、ファイル名に使えません。
↑↑↑
出力成功例(以前にエラーが出なくて出力したことがある)では、
特殊文字など使ってないので、きちんとファイル名で保存されています。
又、文字数も全角50文字程度のファイル名も改行もできて出力されています。

しかし、何度か実行しているとエラー 76 「パスが見つかりません。」が出るのです。
今では、常にエラーになります。

お礼日時：2017/05/11 22:37