• 締切済み

ファイルを移動先のフォルダへ移動させるVBA教えて

とあるシートのB列の値かつAM列の値と、とあるフォルダ内にあるファイルの名称が部分一致したときに、 そのファイルを移動先のフォルダへと移動させるVBAを教えていただけないでしょうか? この内容のVBAを作ったのですが、エラーが出てしまいます(エラーの箇所はコード内に示している)、またこのエラーが影響しているか分からないのですが分別されているのですが上手くいっていません VBA初心者なのでどうか分かりやすくお教えお願い致します Sub 分別() '移動元のフォルダの設定 Const xFrm As String = "C:\before\" '移動先のフォルダの設定 Const xTo As String = "C:\after\" 'アクティブになっているシートのB列の値かつAM列の値と、C:\before内のファイルの名称が部分一致した時、そのファイルをC:\afterへと移動する '((例)B列:M123456、AM列:789、C:\before内のファイル:M123456-789-C12.csv) Dim i As Long, xFile As String With ActiveSheet For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row With .Cells(i, 2) xFile = Dir(xFrm & "*" & .Value & "*") Do While xFile <> "" If xFile Like "*" & .Offset(, 37).Value & "*" Then Name xFrm & xFile As xTo & xFile End If xFile = Dir() Loop End With Next i End With 'C:\before内に残っているファイルを、C:\after2に移動 Dim fso As Object Dim MFir As String Dim SFir As String Set fso = CreateObject("Scripting.FileSystemObject") MFir = "C:\before\*.*" SFir = "C:\after2\" fso.MoveFile MFir, SFir →ここでエラー出る Set fso = Nothing MsgBox "終了" End Sub

みんなの回答

  • masnoske
  • ベストアンサー率35% (67/190)
回答No.2

fso.MoveFile MFir, SFir でエラーが起きるのなら、何度かトライ&エラーしているうちに、すでに SFirが出来ていたのではありませんか? fso.MoveFile は上書きできませんので、先に SFirの存在を確認する必要があります。 存在するなら削除してから fso.MoveFileするかスキップするかです。

  • kkkkkm
  • ベストアンサー率65% (1620/2459)
回答No.1

問題なく動きました。 残ったファイルがないという事はありませんか。 どのようなエラーなのでしょう。

関連するQ&A

  • 2つの列のANDで一致したファイルの移動

    とあるシートのB列の値かつAM列の値と、とあるフォルダ内にあるファイルの名称が部分一致したときに、 そのファイルを移動先のフォルダへと移動させるVBAを教えていただけないでしょうか? この内容のVBAを作ったのですが、エラーが出てしまいます(エラーの箇所はコード内に示している)、またこのエラーが影響しているか分からないのですが分別されているのですが上手くいっていません VBA初心者なのでどうか分かりやすくお教えお願い致します Sub 分別() '移動元のフォルダの設定 Const xFrm As String = "C:\before\" '移動先のフォルダの設定 Const xTo As String = "C:\after\" 'アクティブになっているシートのB列の値かつAM列の値と、C:\before内のファイルの名称が部分一致した時、そのファイルをC:\afterへと移動する '((例)B列:M123456、AM列:789、C:\before内のファイル:M123456-789-C12.csv) Dim i As Long, xFile As String With ActiveSheet For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row With .Cells(i, 2) xFile = Dir(xFrm & "*" & .Value & "*") Do While xFile <> "" If xFile Like "*" & .Offset(, 37).Value & "*" Then Name xFrm & xFile As xTo & xFile End If xFile = Dir() Loop End With Next i End With 'C:\before内に残っているファイルを、C:\after2に移動 Dim fso As Object Dim MFir As String Dim SFir As String Set fso = CreateObject("Scripting.FileSystemObject") MFir = "C:\before\*.*" SFir = "C:\after2\" fso.MoveFile MFir, SFir →ここでエラー出る(実行時エラー53 ファイルが見つかりません) Set fso = Nothing MsgBox "終了" End Sub

  • とあるシートのB列の値かつC列の値と、とあるフォル

    とあるシートのB列の値かつC列の値と、とあるフォルダ内にあるファイルの名称が部分一致したときに、そのファイルを移動先のフォルダへと移動させるVBAを教えていただけないでしょうか? 現在、とあるシートのB列の値と、とあるフォルダ内にあるファイルの名称が部分一致した際に、そのファイルを移動先のフォルダへと移動させるVBAは作成することができました(以下参照) しかし、二つの条件(B列の値かつC列の値(AND?))が部分一致したときのやり方が分からなく困っております、VBA初心者のためどうか教えていただけないでしょうか? Sub 分別() '移動元のフォルダの設定 Const xFrm As String = "C:\before\"'移動先のフォルダの設定 Const xTo As String = "C:\after\"'アクティブになっているシートのB列の値とC:\before内のファイルの名称が部分一致した時、そのファイルをC:\afterへと移動する Dim i As Long, xFile As String With ActiveSheet For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row With .Cells(i, 2) xFile = Dir(xFrm &"*"&.Value &"*") Do While xFile <>""Name xFrm &xFile As xTo &xFile xFile = Dir() Loop End With Next i End With End Sub

  • vba ファイルの移動について

    フォルダAの中にあるたくさんのpdfファイルの中から、 ファイル名の頭文字3つがE列に記載した「aaa」だったら フォルダBに移動させるという内容にしたいです。 ネット検索などで、近いものを作成しましたが(下に貼り付け)、 下から4行目、「fso.moveFile FolderA & "\" & fileName, FolderB & "\" & fileName」で 「実行時エラー'53'  ファイルが見つかりません。」 とエラーが出てしまいます。 どの様に書き直せばよいのでしょうか? どなたかご存じでしたら、ぜひお教え下さい。 よろしくお願いします。 エクセル2010を使用しています。 Sub CheckAndMoveFiles() Dim FolderA As String Dim FolderB As String FolderA = Range("D1").Value FolderB = Range("B2").Value Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim ws As Worksheet Set ws = ActiveSheet Dim lastRow As Long lastRow = ws.Range("E" & Rows.Count).End(xlUp).Row Dim r As Long Dim fileName As String For r = 1 To lastRow If ws.Cells(r, "E").Value <> "" Then fileName = ws.Cells(r, "E").Value dFileName = Dir(FolderA & "\" & Left(fileName, 3) & "*.pdf") Do While dFileName <> "" dFileName = Dir() Loop fso.moveFile FolderA & "\" & fileName, FolderB & "\" & fileName 'ここでストップ End If Next End Sub

  • VBA 一つのフォルダの中のフォルダ名とファイル名

    一つのフォルダの中のフォルダ名とファイル名を取得したい場合は ************************************** Sub test() Dim MyFileName As String Dim MyFolderName As String Dim myFSO As Object Dim MyFolder As Scripting.Folder MyFolderName = "C:\" 'フォルダを取得 MyFileName = Dir(MyFolderName & "*.*") Do While MyFileName <> "" Debug.Print MyFileName MyFileName = Dir() Loop 'ファイルを取得 Set myFSO = CreateObject("Scripting.FileSystemObject") With myFSO With .GetFolder(MyFolderName) For Each MyFolder In .SubFolders Debug.Print MyFolder.Name Next End With End With Set myFSO = Nothing End Sub ************************************** の様に ファイル名・フォルダ名をそれぞれループして取得しないとダメでしょうか? もうちょっとスマートなコードはありますか?

  • VBA初心者です.文字を抽出しファイルを移動したい

    セルA1に表示された文字(例,CK001など)の右から3番目までの文字を拾って,その文字を含むファイルをAからBに移動したいのですが,上手く作動しませんでした.パス内に変数は使用できないのか(ここではZ)「ファイルが見つかりません」となってしまいます.良い方法をご教授いただければ幸いです.下記は自分が作成したプログラムです. Sub Sample() Dim fso As Object Set fso = CreateObject("scripting.filesystemobject") Dim A As String Dim B As String Dim Z As Variant Z = Right(Range("A1"), 3) A = "C:\Users\abc\Documents\test\*Z*" B = "C:\Users\abc\Desktop\1\2\" fso.MoveFile A, B End Sub

  • VBA:2つのCSVファイルを開きたいです。

    エクセル2010のVBAにてCSVファイルを開き結合させるプログラムを組もうとしているのですが、2つ目のCSVファイルを開こうとすると、何故かエラーが出てしまいます。 -------------------------------------------------------------------------------- 1つ目 Sub mobile_FileSearch(Path As String) 'test.csvのデータを検索して開く Dim FSO As Object, Folder As Variant, File As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders Call mobile_FileSearch(Folder.Path) Next Folder For Each File In FSO.GetFolder(Path).Files If File.Name = "test.csv" Then Workbooks.Open ("test.csv") End If Next File End Sub ---------------------------------------------------------------------------- 2つ目 Sub local_FileSearch(Path As String) 'bbb.csvのデータを検索して開く Dim FSO As Object, Folder As Variant, File As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders Call local_FileSearch(Folder.Path) Next Folder For Each File In FSO.GetFolder(Path).Files If File.Name = "bbb.csv" Then Workbooks.Open ("bbb.csv")'←ここでエラー End If Next File End Sub ------------------------------------------------------------------------ まったく同じプログラムで、csvファイル名だけ変えただけで実行時エラー1004が出てしまいます。 一体全体何が問題なのでしょうか?

  • フォルダの中のファイル数を取得するには vba

    手作業でフォルダのプロパティからファイルの数を確認することはできるのですが VBAで(FSOなど)、該当のフォルダの中に何個ファイルが入ってるかを確認するコードはありますか? Sub test() Dim MyFileName As String Dim MyFolderName As String Dim i As Long MyFolderName = "\○○\icon" MyFileName = Dir(MyFolderName & "\*.*") Do While MyFileName <> "" MyFileName = Dir() i = i + 1 Loop MsgBox i End Sub このようなコードを作ってみたのですが、 画像のように実際に目で確認したファイル数と一致しません。 正しい数が取得できるvbaコードはありますか?

  • サブフォルダ内のファイル名取得について

    Windows7 Access 2013環境です。 USB接続したハードディスク内のファイルリストを作成しようとしています。 ハードディスクはNTFSフォーマットです。 ボタン1をクリックしたとき、テーブル1をソースにしたフォーム1に ファイル名を書き出していくようにしました。 ドライブ内のサブフォルダを選択すると、プログラムは正常に作動するのですが ドライブ直下を指定すると、実行時エラー 70 "書き込みできません" が発生します。 NTFSのアクセス権は、管理者でログインしているので、システム関連のフォルダ System Volume Information $RECYCLE.BIN 以外は問題ありません。 どこに問題があるのでしょうか。もし、システム関連のフォルダが 引っかかっているとしたら、その回避方法についても 具体的にご教授願います。 ↓エラー箇所↓ -------------------------------------------------------------- For Each subfolder In folder.SubFolders -------------------------------------------------------------- ↓作成したプログラム↓ -------------------------------------------------------------- Private Sub ボタン_1_Click() Dim dlg As FileDialog Dim fold_path As String Dim strTargetDir As String DoCmd.GoToRecord acDataForm, "F0001_フォーム1", acNewRec Set dlg = Application.FileDialog(msoFileDialogFolderPicker) If dlg.Show = False Then Exit Sub fold_path = dlg.SelectedItems(1) strTargetDir = fold_path Call FolderSearch(strTargetDir) MsgBox "終了" Set dlg = Nothing Else End If End Sub Public Sub FolderSearch(strTargetDir As String) Dim fso As Object Dim folder As Object Dim subfolder As Object Dim file As Object Dim objFilsSys As Object Dim objDrive As Object Dim strDriveLetter As String Set fso = CreateObject("Scripting.FileSystemObject") Set folder = fso.GetFolder(strTargetDir) strDriveLetter = Left(strTargetDir, 1) Set objFileSys = CreateObject("Scripting.FileSystemObject") Set objDrive = objFileSys.GetDrive(strDriveLetter) For Each subfolder In folder.SubFolders  ←エラー箇所 FolderSearch subfolder.Path Next subfolder For Each file In folder.Files With file Me.ボリューム名 = objDrive.VolumeName Me.ファイル名 = file.Name Me.ファイルパス = folder.Path Me.ファイルサイズ = folder.Size DoCmd.GoToRecord acDataForm, "F0001_フォーム1", acNewRec End With Next file Set objDrive = Nothing Set fso = Nothing Set folder = Nothing End Sub

  • VBA フォルダ内ファイルにマクロ一括処理

    フォルダ内ファイルのマクロを一括実行したいです。 フォルダ内ファイル全てに下記のマクロを登録 Sub 値貼り付け() 'シート4番目を選択 Sheets(4).Select 'シート名1文字目が「★」以外のシートを選択 For Each i In ThisWorkbook.Sheets If Not i.Name Like "★*" Then i.Select Replace:=False End If Next i '全セル選択 Cells.Select 'コピー Selection.Copy '値貼り付け Selection.PasteSpecial Paste:=xlPasteValues Cells(1, 1).Select Sheets(1).Select '「.xlsx」で保存 Application.DisplayAlerts = False Dim fso, f Set fso = CreateObject("Scripting.FileSystemObject") With ActiveWorkbook f = fso.GetBaseName(.Name) .SaveAs .Path & "\" & f & "保存.xlsx", FileFormat:=xlWorkbookDefault .Close End With Set fso = Nothing End Sub 一括でマクロを実行する用のファイルに下記マクロを登録 Sub 一括処理() Dim Fpath As String Dim Fname As String Dim Wb As Workbook Fpath = ThisWorkbook.Path & "\" Fname = Dir(Fpath & "*.xlsm") Do Until Fname = "" If Fname = ThisWorkbook.Name Then Else Application.DisplayAlerts = False 'ブックを開く Set Wb = Workbooks.Open(Fpath & Fname) 'マクロ実行 Application.Run "'" & Fname & "'!値貼り付け" Wb.Close SaveChanges:=True Application.DisplayAlerts = True End If Fname = Dir() Loop End Sub 一括処理の実行をすると、フォルダ内の一つのファイルだけ マクロ実行されると終了してしまいます。 各々のファイルには他にもマクロを登録していて、そちらは 'マクロ実行 Application.Run "'" & Fname & "'!値貼り付け" のマクロの名前部分を変更して、同様に一括処理していますが 問題なく動きます。 なぜかこの「値貼り付け」のマクロだけ全ファイルに動作して くれません。 色々自分なりに調べているのですが、どうしても原因不明で 今回投稿させて頂きました

  • EXCEL VBAでフォルダ容量の測定

    お世話になります. EXCELでフォルダの容量を自動で測量するツールを作成中です. 大まかな概要としては,1枚目のシートのセルにあらかじめ測定対象となるフォルダのパスを記述しておき, そのパスをもとに2枚目のシートに測定した容量を出力したいと考えています. 作成中のソースから抜粋させて頂きますが,以下の部分が上手くいきません. <<作成中のソース>> Sub FolderSize_Count() Dim FSO As Variant Set FSO = CreateObject("Scripting.FileSystemObject") Dim Path As String With Sheets("Sheet2") Path = Application.Worksheets("sheet1").Range("A1").Value .Cells(1, 1) = FSO.GetFolder("Path").Size End With End Sub <<不明点>> FSO.GetFolder("Path").Size の"Path"の部分には対象フォルダのパスを記述する必要があるが, 別シートから取得した値を" "に反映させる記述が分かりません. ちなみに Application.Worksheets("sheet1").Range("A1").Valueにて,対象フォルダのパスを取得出来ていることと, FSO.GetFolder("C:\test").Sizeにて,Cドライブ直下のtestフォルダの容量を取得できることは確認済みです. お手数お掛けいたしますが,有識者の方,ご教授頂ければ幸いです. 以上,よろしくお願いいたします.

専門家に質問してみよう