- ベストアンサー
マクロを実行すると、エラーにならずに、じりじり音がしてしまう
Wendy02の回答
こんにちは。Wendy02です。 最初に、 >翌日、ソフト2つが起動してる状態で、実行しましたら、エラーになる。 私が書いたのは、FileSearch が、Dependency がおかしくなっているのでは?ということです。FileSearch は、もともと外部ツールなので、何かが、占有していたら、ダメになるのではないか、と考えたのです。ただし、コードを見る限りは、そんな必要はなさそうです。 それで、基本的なことですが、あまり、FileSearch のプロパティを省略した書き方はしないほうがよいですね。本当にわかっていればよいのですが、時々、回答者で、ヘンなことを教える方がいます。 >1、 「*.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
お礼
誠に有難うございました。 コードについても併せてお礼申し上げます。