マクロを実行すると、エラーにならずに、じりじり音がしてしまう

Question

EXCEL2002です。（セキュリティは低です）
いままで、問題なく実行できてたんですが、このような現象は始めてです。
他のマクロは問題なく、実行できておりますが、このマクロだけがおかしいんです。

問題内容の経緯
１、　最初の　1回　の実行時、下記の線で挟まれた部分だけが、エラーで反転された。
２、　次に、VBの画面だけを閉じて、再度実行しましたら、今度はエラーにならずに、その後は何度実行しても、「　じりじり音　」　がしてしまうだけで、休止してるような状態です。（フリーズはしません）
３、　休止して動かないが、マウスは動きますので、EXCELを閉じますと、
　　　「　このプログラムに応答はありません　」　の画面表示されますので、「　すぐに終了　」　ボタンで、終了した。
４、　PCを再起動して、何度再実行しましたが、エラーにはならずに「２～３」の繰り返しで、全く変わらない状態です。

自身で気が付くことは、最近、マイドキュメントに、PDFファイル等を100Mぐらい、保存したぐらいですが。
他には、フリーソフト等を試しにインストールし使用しました。

以上　よろしくお願い致します。

For i = 1 To .FoundFiles.Count
   '見つかった　「　*.csvファイル　」　を一つずつ開く
-----------------------
   Workbooks.OpenText Filename:=.FoundFiles(i), _
   StartRow:=1, _
   DataType:=xlDelimited, _
   TextQualifier:=xlDoubleQuote, _
   ConsecutiveDelimiter:=False, _
   Comma:=True
------------------------
 'ああ.xlsブックに移動
Sheets(1).Move after:=Workbooks("ああ.xls").Worksheets(Workbooks("ああ.xls").Sheets.Count)
Next i

Wendy02 · Accepted Answer

こんにちは。Wendy02です。

最初に、
>翌日、ソフト２つが起動してる状態で、実行しましたら、エラーになる。
私が書いたのは、FileSearch が、Dependency がおかしくなっているのでは？ということです。FileSearch は、もともと外部ツールなので、何かが、占有していたら、ダメになるのではないか、と考えたのです。ただし、コードを見る限りは、そんな必要はなさそうです。

それで、基本的なことですが、あまり、FileSearch のプロパティを省略した書き方はしないほうがよいですね。本当にわかっていればよいのですが、時々、回答者で、ヘンなことを教える方がいます。

>１、　「*.csv」　を一端、開かないと、データを書き込むことはできないものなんですか？

できますが、逆に、面倒です。Input ステートメントで、テキストラインをSplit関数で分割し、配列にして、それぞれのシートに貼り付けます。

ためしに、元のコードを元にして、こちらでコードを作ってみました。
コピー先ブックが開いていない場合は、ブックが開きます。コピー先ブックが見つからなければ、ブックを作ります。
このコードで調べてみてください。

Sub testCSVImport()
　　Dim strLookIn As String
　　Dim wb As Workbook
　　Dim Files As Variant
　　Dim fn As Variant
　　Dim i As Integer
　　Dim j As Integer
　
　　'コピー先ブックの設定
　　Const DSTINBOOK As String = "ああ.xls"
　　'ファイルの検索場所
　　strLookIn = ThisWorkbook.Path
　
　　On Error GoTo ErrHandler
　　Set wb = Workbooks(DSTINBOOK) 'ブックがあるかチェックする
　　
　　For j = wb.Sheets.Count To 2 Step -1
　　　　Application.DisplayAlerts = False
　　　　wb.Sheets(j).Delete
　　　　Application.DisplayAlerts = True
　　Next j
　　wb.Sheets(1).Name = "FirstSheet" '最初のシート
　
　　'FileSearchによる csv ファイルの検索
　　With Application.FileSearch
　　　　.NewSearch　'必ず入力する
　　　　.Filename = "*.csv"
　　　　.LookIn = strLookIn
　　　　.SearchSubFolders = False
　　　　.MatchTextExactly = True
　　　　.FileType = msoFileTypeAllFiles
　　　　If .Execute > 0 Then
　　　　　　Set Files = .FoundFiles
　　　　Else
　　　　　　MsgBox "検索条件を満たすファイルはありません。"
　　　　　　Exit Sub
　　　　End If
　　End With
　　'シートのコピー
　　i = 1 'iの初期値
　　Application.ScreenUpdating = False
　　For Each fn In Files
　　　　With Workbooks.Open(Filename:=fn)
　　　　　　.ActiveSheet.Copy After:=wb.Worksheets(i)
　　　　　　.Close False
　　　　End With
　　　　i = i + 1
　　Next fn
　
　　'最初のシートを削除(残しておいても良いかと思います）
　　Application.DisplayAlerts = False
　　　 wb.Worksheets("FirstSheet").Delete
　　Application.DisplayAlerts = True
　　Application.ScreenUpdating = True
　　''wb.Save　'保存が必要な場合
　　Set wb = Nothing
　　Exit Sub
ErrHandler:
　　'エラー時に、コピー先ブックを開く
　　If Err.Number = 9 Then
　　　　If Dir(DSTINBOOK) = "" Then
　　　　　　Set wb = Workbooks.Add
　　　　　　　　wb.SaveAs DSTINBOOK
　　　　　　Resume Next
　　　　Else
　　　　　　Set wb = Workbooks.Open(DSTINBOOK)
　　　　　　Resume Next
　　　　End If
　　Else
　　　　MsgBox Err.Number & " :" & Err.Description
　　　　Exit Sub
　　End If
End Sub

Wendy02 · Answer

こんにちは。

まず、どこまでコードが通っているか、調べてみてください。ブレイク・ポイントを置けば分かるはずです。

全体が書かれていないのではっきりしない部分がありますが、FileSearch オブジェクトは、NewSearch コマンドは入っていますか？

私としては、以下のどこに問題があるか、それだははっきりしたいと思います。

For i = 1 To .FoundFiles.Count
Workbooks.OpenText Filename:=.FoundFiles(i), _

ちゃんと、.FoundFiles.Count の数は取れていますか？
ここの　.FoundFiles(i)　ファイル名はちゃんと取れているか、調べてみてください。

記録マクロからのようですが、
TextQualifier:=xlDoubleQuote, _ 
の行を削除してみるか、

または、正しい書き方に戻してみるとか。
TextQualifier:= xlTextQualifierDoubleQuote

ただ、もしも、トラブルがコードの中にないようでしたら、最終的には、このコード自体を、あきらめたほうがよいです。もともと、TextOpenメソッドは、CSVの特殊なものに使う書き方ですから、コードを見ている限り、特殊な部分はないように思います。

それから、そのコード自体は、外部ツールを使っているので、そのツール自体の依存性(Dependency)が壊れていると、そのままの状態では、容易には修復は難しいかもしれません。いろんなソフトを入れていますと、しょうがないのです。別に特別にOSとかOffice が壊れたようなことではなくて、VBAを専門に扱う人は、私を含めて、みんな、一度は経験する話のようです。だから、この手の質問の回答では、手抜き（＝初級のコード）をしなければ、別のコードを書くのですね。

imogasi · Answer

Sub test01()
With Application.FileSearch
    .LookIn = "C:\Documents and Settings\XXXX\My Documents"
    ' .FileType = msoFileTypeExcelWorkbooks
    .FileType = msoFileTypeAllFiles
    .Filename = "*.csv"
    .Execute
End With
Dim i As Integer
With Application.FileSearch
For i = 1 To .FoundFiles.Count
    MsgBox .FoundFiles(i)
        Workbooks.OpenText Filename:=.FoundFiles(i), _
        StartRow:=1, _
        DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, _
        Comma:=True
        '----
        n = Workbooks("CSV集約.xls").Sheets.Count
        MsgBox n
ActiveWorkbook.Sheets(1).Move after:=Workbooks("CSV集約.xls").Worksheets(n)
Next i
End With
End Sub
を標準モジュールに貼り付ける。
フォルダーの部分を自分のケースに合わせる。
CSV集約.xlsで保存。
再度CSV集約.xlsを読み込んで、実行。
私の場合はうまく行ったようですが、うまくいくでしょうか。
うまくいった場合は、質問のコードと比べて検討してみてください。
ーー
うまくいかない場合は、回答が不適切だと思うので、本件は無視してください。

マクロを実行すると、エラーにならずに、じりじり音がしてしまう

こんにちは。

こんにちは。

この回答への補足

Sub test01()

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング