• 締切済み

VBAで実行時エラー1004が出てしまう

実行時エラー1004で「申し訳ございません。が見つかりません。名前が変更されたか、移動や削除がおこなわれた可能性があります。」と表示されてしまう。 あるフォルダ内にある複数のファイルから、作成日・更新日が最新のファイルのシートを作業中のブックにコピーするVBAなのですが上記のエラーが出てしまい原因が分かりません。 VBA初心者なので基本的なことかもしれませんがアドバイスよろしくお願い致します。 Sub コピー() Dim FileTime As Date Dim MaxTime As Date Dim FileName As String Dim MaxFileName As String With CreateObject("WScript.Shell") 'カレントフォルダを指定 .CurrentDirectory = "C:\Users\○○\Desktop\○○\○○\○○\" End With FileName = Dir("*.xlsx") 'ワイルドカードで拡張子「xlsx」ファイルを取得 Do While FileName <> "" 'ファイルを取得出来なくなるまでループ FileTime = FileDateTime(FileName) '取得したファイルの日時を取得 If FileTime > MaxTime Then '時間を比較 MaxTime = FileTime '日付が大きい場合は格納 MaxFileName = FileName '日付が大きい場合はファイル名を格納 End If FileName = Dir() Loop ShCount = ThisWorkbook.Worksheets.Count '実行したファイルのシート数を取得 Workbooks.Open MaxFileName　←ここでエラーが出る Worksheets(2).Copy after:=ThisWorkbook.Worksheets(ShCount) 'シートの2つ目を指定して末尾に追加 Workbooks(FileName).Close savechanges:=False '取得したファイルを閉じる End Sub

回答 全件
Workbooks.Open MaxFileName　←ここでエラーが…

みんなの回答

回答No.1

Workbooks.Open MaxFileName　←ここでエラーが出る MaxFileNameをルートからのフルパスにする必要がありますね。 C:\abc\efg\hijk.xlsx MaxFileNameにはhijk.xlsxしかはいっていません。

全文を見る
すると、全ての回答が全文表示されます。
  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • Excel VBA連続コピー、貼付処理について

    特定のフォルダ内に格納されている複数のExcelファイルの「sheet1」シートのデータを 所定のExcelファイルにコピー＆ペーストしたいのですが、うまくいきません。 （貼付先のファイルを閉じようとするとエラーが発生します。） どうすればできるようになるでしょうか? ご教授の程よろしくお願いいたします。 -------------------------------------------------------------------- Sub copy_test() Dim myPath As String Dim copyFile As String Dim pasteFile As String Dim n As Long myPath = "C:\copy\" copyFile = Dir(myPath & "*.xls*") pasteFile = "C:\paste\paste_data.xlsx" n = 2 Do Until copyFile = "" Workbooks.Open Filename:=myPath & copyFile Workbooks(copyFile).Worksheets("sheet1").Range("A2:L201").Copy Workbooks.Open Filename:=pasteFile 'Workbooks(pasteFile).Worksheets("paste_data").Active Range("B1").Select Selection.End(xlDown).Select Selection.End(xlToLeft).Select Selection.End(xlUp).Select ActiveCell.Offset(1, 0).Select ActiveSheet.Paste ActiveWorkbook.Save Workbooks(pasteFile).Close False Application.CutCopyMode = False Workbooks(copyFile).Close False n = n + 999 copyFile = Dir() Loop End Sub ---------------------------------------------------------------------------------

  • VBA　実行時エラー　424　の表示が出る

    下記のVBAを作成していてエラーが出てしまいます 8行目でオブジェクトが必要ですと表示が出るのはなぜでしょうか？ やりたいこととしてはボタンを選択すると特定のシート[ADDR_TO]を 同一階層上に[ADDR_TO]のファイル名でCSVとして保存することです ---- Private Sub CommandButton2_Click() Dim strNewBookName As String strNewBookName = "ADDR_TO" Workbooks.Add.SaveAs Filename:=ThisWorkbook.Path & "\" & strNewBookName, FileFormat:=xlCSV SheetCSV.Cells.Copy With Workbooks(strNewBookName & ".csv") .Worksheets(strNewBookName).Range("A1").PasteSpecial Paste:=xlPasteAll .Worksheets(strNewBookName).Range("A1").Select .Save .Close End With Call MsgBox("出力完了", vbInformation) End Sub

  • VBAでエラーが出ます

    セルの値を変数に格納して、それをブック保存時に使いたいのですが上手くいきません。 Sub サンプルブック保存() Dim myfile As String myfile = workbooks("サンプル").Worksheets("sheet1").Cells(2, 9) workbooks.Add ActiveWorkbook.SaveAs Filename:="\\C:\フォルダ\" & myFile & ".xls" End Sub エラーメッセージは、 実行時エラー'1004': SaveAs'メソッドは失敗しました'_Workbook'オブジェクト と出ます。 非常に困ってます。 教えてくだされば幸いです。

  • VBAで複数シートをまとめたい

    VBAを作るのは今回が初めてで行き詰ってしまいました。 フォルダ内の「.xlsx」４つのファイルのSheet1(４つともSheet1です) を統合.xLsmの1月シートのb2～値でコーピー貼り付けを行いたいのですが、 下記のものでやっていけば出来のかなと思ってますが、ご教授お願い致します。 Private Sub CommandButton1_Click() Dim sFile As String Dim sWB As Workbook, dWB As Workbook Dim dSheetCount As Long Dim i As Long Dim c As Long Dim ws As Worksheet Debug.Print (ws.Index) Const SOURCE_DIR As String = "C:\Users\KWEUSER\Desktop\data\" Application.ScreenUpdating = False '指定したフォルダ内にあるブックのファイル名を取得 For c = 1 To 4 sFile = Dir(SOURCE_DIR & "*.xlsx") 'フォルダ内にブックがなければ終了 If sFile = "" Then Exit Sub '集約用ブックを作成 Set dWB = Workbooks.Add '集約用ブック作成時のシート数を取得 dSheetCount = dWB.Worksheets.Count Do 'コピー元のブックを開く Set sWB = Workbooks.Open(Filename:=SOURCE_DIR & sFile) 'コピー元の　c (1,2,3,4,5)シートを集約用ブックにコピー sWB.Worksheets(c).Copy After:=dWB.Worksheets(dSheetCount) 'シート名をファイル名に ActiveSheet.Name = sFile 'コピー元ファイルを閉じる sWB.Close '次のブックのファイル名を取得 sFile = Dir() Loop While sFile <> "" '集約用ブック作成時にあったシートを削除 Application.DisplayAlerts = False For i = dSheetCount To 1 Step -1 dWB.Worksheets(i).Delete Next i Application.DisplayAlerts = True '集約用ブックを保存して閉じる dWB.SaveAs Filename:="C:\Users\KWEUSER\Desktop\data\" & c & ".xlsx" dWB.Close Next Application.ScreenUpdating = False End Sub

  • VBA　.WorksheetFunctionについて

    Dim DestBook As Workbook Dim pathmacrobook As String Dim namebook As String Dim myb As Range Dim r As Long Application.ScreenUpdating = False ThisWorkbook.Activate pathmacrobook = ThisWorkbook.Path & "\" & Worksheets("sheet1").Cells(1, 3).Value & "\" Set DestBook = Workbooks("残高集計用.xls") namebook = Dir(pathmacrobook & "*.xls") Do While Not namebook = "" Set myb = DestBook.Worksheets("sheet3").Range("A65536").End(xlUp) With Workbooks.Open(pathmacrobook & namebook) r = aplication.WorksheetFunction.MatchThisWorkbook.Worksheets("sheet1") .Range("C3:AH3"), namebook.Worksheets("sheet1").Range("C"), 0) If r > 0 Then .Close False Else With Workbooks.Open(pathmacrobook & namebook) .Worksheets("Sheet1").UsedRange.Offset(1).Copy myb.Offset(1) 　　　　　lngREC = lngREC + 1 .Close False End With End If namebook = Dir() Loop Set DestBook = Nothing MsgBox lngREC & "日分" & "読込完了しました" 上記のコードについてですが、修飾子が不正です。や、 Loopに対するDoがありません等エラーが出てしまいます。 やりたい事は、"namebook"を開いた時、"Thisworkbook"のsheet3のC列に"namebook"のsheet1のC列があれば、 "namebook"閉じ、そうでなければコピーするというようにしたいです。 どなたかご教授お願いします。

  • 一括印刷vba　エラー

    複数シートの印刷vbaを作成したのですが、インデックスが有効範囲ではありませんのエラーが発生します。該当部分のコードは以下のとおりで、配列変数に格納したシート名でシートを選択しようとするときにエラーとなります。 デバックで追ってみると、シート名の変数への格納も、配列変数の個数の宣言もきちんと入っているようなのですが・・・。 vbaは初心者で、基本的なこともあまりわからないレベルです。ヘルプやインターネットで調べても何が悪いのかよくわかりませんでした。 どこを直せばよいのか教えてもらえると助かります。 '連続印刷(１ファイル内のシート全てをひとかたまりで印刷) Dim Sh As Worksheet Dim AllShName() As Variant Dim x As Long For i = 1 To iRow Workbooks.Open Filename:=fil_path & ran1(i) & ".xlsx" x = 0 For Each Sh In ActiveWorkbook.Worksheets x = x + 1 ReDim Preserve AllShName(x) AllShName(x) = Sh.Name Next Worksheets(AllShName).Select　　　←　ここで「インデックスが有効範囲ではありません」のエラー ActiveWindow.SelectedSheets.PrintOut ActiveWindow.Close Next i End Sub

  • VBAで実行時エラーとコピーの仕方

    始めまして、宜しくお願い致します。拡張子がxlsmの中に名前のついた10個のsheetがあります。この10個のsheetを拡張子がxlsxのBookにコピーしたいのですが、実行時エラーが出ます。作成したマクロは Option Explicit Option Base 1 Public Sub シートの纏め() Dim i As Long Dim mySheetCnt As Long Dim mySheetName() As String Dim ws As Workbook Dim s As Worksheet '========================================================================== mySheetCnt = ThisWorkbook.Sheets.count ReDim mySheetName(1 To mySheetCnt) For i = 1 To mySheetCnt - 3 mySheetName(i) = Sheets(i).Name 'ここで実行時エラーが出ます。 'MsgBox "変数mySheetName(" & i & ")=" & mySheetName(i) Next i '========================================================================== Dim EffectiveRow As Long Dim EffectiveColumn As Long EffectiveRow = Range("B65536").End(xlUp).Row 'MsgBox "EffectiveRow = " & EffectiveRow & "" EffectiveColumn = Cells(4, 256).End(xlToLeft).Column 'MsgBox "EffectiveColumn = " & EffectiveColumn & "" '========================================================================== 'MsgBox "デフォルトで" & Application.SheetsInNewWorkbook & "枚作成されます" Application.SheetsInNewWorkbook = 1 Workbooks.Add '========================================================================== For i = 1 To mySheetCnt - 3 If mySheetCnt = 11 Then GoTo Label1 MsgBox "mySheetName(i) = " & mySheetName(i) & "" Workbooks("Book1.xls").Worksheets("sheet1").Range("A4").Select Next i Label1: End Sub です。ここでコメント欄にエラーと書かれた部分で実行時エラーが起こります。エラーメッセイジは、 実行時エラー「'9'インデクスが有効範囲にありません。」と出ます。また、拡張子がxlsmにある10個名前のついたsheetを拡張子xlsxを作り、1つのsheetに纏めたいのですが、方法が判りません。纏め方は、10個名前のついたsheetから、新たに作ったsheetに下から上に順番にコピーしたいのですが、方法がわかりませ。どなたかご教授して頂きたく宜しくお願い申し上げます。実行環境はWindowsXPSP3でEXCELは2010を使っております。

  • VBAのコードについて

    VBA初心者でございます。 以下のコードの後半（End If以降）でエラーがでてしまいます。 非常に乱暴な質問で大変恐れ入りますが、コードで気になる点などございますでしょうか？ もしございましたら、ご教示頂けますと幸いです。 どうぞ宜しくお願いいたします。 Sub 絞り込み() Dim i As Long Dim grp As String Dim newBookName As String Dim newBookPath As String Dim newBook As Workbook For i = 2 To 4 grp = Workbooks("test_master").Worksheets("grpリスト").Cells(i, 2) newBookName = Workbooks("test_master").Worksheets("grpリスト").Cells(i, 2) & ".xlsx" newBookPath = ThisWorkbook.Path & "\" & newBookName '指定したパスにファイルが作成済でないかを確認。 If Dir(newBookPath) = "" Then '新しいファイルを作成 Set newBook = Workbooks.Add '新しいファイルをVBAを実行したファイルと同じフォルダ保存 newBook.SaveAs newBookPath Else '既に同名のファイルが存在する場合はメッセージを表示 MsgBox "既に" & newBookName & "というファイルは存在します。" End If Workbooks("test_master").Worksheets("マスタ0701").AutoFilterMode = False With Workbooks("test_master").Worksheets("マスタ0701").Range(Cells(3, "B"), Cells(Rows.Count, "CK").End(xlUp)) .AutoFilter Field:=13, Criteria1:=grp '.CurrentRegion.Select Range(Cells(3, "B"), Cells(Rows.Count, "CK").End(xlUp)).SpecialCells(xlVisible).copy Workbooks(grp).Worksheets("Sheet1").Range("A1") '.AutoFilter End With Next i End Sub

  • VBA 実行時エラーで、"プロパティまたはメソッド

    ・Sheet1(コード) Private Sub CommandButton1_Click() Call aaa End Sub ・Module1(コード) Sub aaa() Dim wb As Workbook Dim ws As Worksheet Workbooks.Open ("c:\test.xls") Set wb = Workbooks("test.xls") Set ws = wb.Worksheets("Sheet1") wb.ws.Range("A2").Value = "CCC" End Sub wb.ws.Range("A2").Value = "CCC"の部分で 以下の実行エラーが出ます。 ------------------------------------------------------------------------ 実行時エラー'438': オブジェクトは、このプロパティまたはメソッドをサポートしていません。 ------------------------------------------------------------------------ Set wb = Workbooks("test.xls") Set ws = wb.Worksheets("Sheet1") の部分で特にエラーも出ないので、オブジェクトの取得は成功していると 思うのですが、WorkSheetオブジェクトのwsからRangeメソッドを呼ぶことが できません。 動かない原因と対策を教えてください！！

  • EXCEL2000とEXCEL2003のVBAについて

    現在、EXCEL2000で下記のコードを実行しています。 が、EXCEL2003で実行すると、 .UsedRange.Copy myb のコードが実行されているのにコピー出来ていません。 ファイルは開いていて、エラーは出ていないのです。 問題点わかる方教えていただけますか？ Sub 日別データ読込() Dim rngsaki As Range Dim pathmacrobook As String Dim namebook As String Dim motobook As Workbook Dim myb As Variant Set rngsaki = Workbooks("残高集計用.xls").Worksheets(3).Range("a2") pathmacrobook = ThisWorkbook.Path & "\CSV読込データ12\" namebook = Dir(pathmacrobook & "*.xls") Do While Not namebook = "" Set motobook = Workbooks.Open(pathmacrobook & namebook) Set myb = Workbooks("残高集計用.xls").Worksheets(3).Range("A65536").End(xlUp) With motobook.Worksheets("Sheet1") .UsedRange.Copy myb End With motobook.Close False namebook = Dir() Loop MsgBox "完了しました" End Sub

パソコンが無くてもダウンロードできる方法とは？
このQ&Aのポイント
  • パソコンを持っていなくても、ダウンロードする方法があります。
  • iPadを使用することで、パソコンのようにダウンロードすることができます。
  • もし方法があれば、教えてください。
回答を見る

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する