Excelのマクロについて教えてください。

Question

下記のマクロは先日教えて頂いたマクロで、マクロを実行すると
フォルダ：検査時必要図書（正本）の中にある、PDFファイルを
フォルダ：########-#_交付用
にコピーできます。
このコードを
フォルダ：検査時必要図書（正本）を無くして
マクロ設定ブックと同じフォルダ内にあるPDFファイルを
マクロ設定ブックと同じフォルダ内にある
フォルダ：########-#_交付用
に移動出来る方法を教えてください。（親切に詳しいコード共教えてください）
宜しくお願い致します。
現状のマクロ
Sub 交付用に移動()
On Error Resume Next
Dim myPath As Variant
Dim fPath As String, fname As String
fPath = ThisWorkbook.Path
' myPath 変数にフォルダパスを取得
myPath = folder_acquisition(fPath)
' 「交付用_A3」で終わるPDFファイルを取得
fname = Dir(myPath(1) & "*（交付用_A3）.pdf")

Do While fname <> ""
' ファイルのコピーを実行
FileCopy myPath(1) & fname, myPath(2) & fname
fname = Dir
Loop
End Sub

Function folder_acquisition(fPath As String) As Variant()
Dim fso As Object, f As Object
Dim n As Integer
Dim myPath(2) As Variant
Set fso = CreateObject("Scripting.FileSystemObject")

' 検査時必要図書（正本）フォルダの取得
myPath(1) = fPath & "\検査時必要図書（正本）\"

' フォルダ内のサブフォルダを走査し、「_交付用」で終わるものを見つける
For Each f In fso.GetFolder(fPath).SubFolders
Dim folderName As String
folderName = Mid(f.Path, InStrRev(f.Path, "\") + 1)

' フォルダ名が「8桁の英数字-1_交付用」というパターンに一致する場合
If folderName Like "########-#_交付用" Then
myPath(2) = f.Path & "\"
n = n + 1
End If

' 必要なフォルダが見つかったら終了
If n = 2 Then Exit For
Next f

Set fso = Nothing
folder_acquisition = myPath()
End Function
以上となります。
宜しくお願い致します。

kuukun107 · Accepted Answer

PDFファイルをコピーではなく移動するためには、FileCopy の代わりに Name ステートメントを使ってファイルの場所を変更するように修正します。

以下のコードは、元のフォルダから目的のフォルダにPDFファイルを移動するマクロです。

Sub 交付用に移動()
On Error Resume Next
Dim myPath As Variant
Dim fPath As String, fname As String
fPath = ThisWorkbook.Path
' myPath 変数にフォルダパスを取得
myPath = folder_acquisition(fPath)
' 「交付用_A3」で終わるPDFファイルを取得
fname = Dir(myPath(1) & "*（交付用_A3）.pdf")

Do While fname <> ""
' ファイルの移動を実行
Name myPath(1) & fname As myPath(2) & fname
fname = Dir
Loop
End Sub

Function folder_acquisition(fPath As String) As Variant()
Dim fso As Object, f As Object
Dim n As Integer
Dim myPath(2) As Variant
Set fso = CreateObject("Scripting.FileSystemObject")

' 現在のフォルダ内のPDFファイルがあるパスを取得
myPath(1) = fPath & "\"

' フォルダ内のサブフォルダを走査し、「_交付用」で終わるものを見つける
For Each f In fso.GetFolder(fPath).SubFolders
Dim folderName As String
folderName = Mid(f.Path, InStrRev(f.Path, "\") + 1)

' フォルダ名が「8桁の英数字-1_交付用」というパターンに一致する場合
If folderName Like "########-#_交付用" Then
myPath(2) = f.Path & "\"
n = n + 1
End If

' 必要なフォルダが見つかったら終了
If n = 2 Then Exit For
Next f

Set fso = Nothing
folder_acquisition = myPath()
End Function

この修正版では、FileCopyの代わりに Name ステートメントを使用しています。Name <元のファイルパス> As <移動先のファイルパス> という形で、元のフォルダから目的のフォルダにファイルが移動されます。

私には，全く理解出来ませんが
参考になれば幸いです。
今夜は生成AIの使用制限が
かかりましたので
本日最後の解答となります。

kuukun107 · Answer

コードの修正として、以下のように変更することで、**「検査時必要図書（正本）」フォルダがなくても、マクロ設定ブックと同じフォルダにあるPDFファイルを、同じフォルダ内にある「########-#_交付用」**フォルダに移動することができます。

以下のコードをご確認ください。

Sub 交付用に移動()
    On Error Resume Next
    Dim myPath As Variant
    Dim fPath As String, fname As String
    fPath = ThisWorkbook.Path
    
    ' myPath変数にコピー元とコピー先のフォルダパスを取得
    myPath = folder_acquisition(fPath)
    
    ' コピー元のフォルダから「交付用_A3」で終わるPDFファイルを取得
    fname = Dir(myPath(1) & "*.pdf")
    
    Do While fname <> ""
        ' ファイルのコピーを実行
        FileCopy myPath(1) & fname, myPath(2) & fname
        fname = Dir
    Loop
End Sub

Function folder_acquisition(fPath As String) As Variant()
    Dim fso As Object, f As Object
    Dim n As Integer
    Dim myPath(2) As Variant
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' マクロと同じフォルダをコピー元フォルダとして設定
    myPath(1) = fPath & "\"
    
    ' フォルダ内のサブフォルダを走査し、「_交付用」で終わるものを見つける
    For Each f In fso.GetFolder(fPath).SubFolders
        Dim folderName As String
        folderName = Mid(f.Path, InStrRev(f.Path, "\") + 1)
        
        ' フォルダ名が「8桁の英数字-1_交付用」というパターンに一致する場合
        If folderName Like "########-#_交付用" Then
            myPath(2) = f.Path & "\"
            n = n + 1
            Exit For ' 必要なフォルダが見つかったら終了
        End If
    Next f
    
    Set fso = Nothing
    folder_acquisition = myPath()
End Function

コードの変更点と説明

1.	コピー元のフォルダ設定を変更
myPath(1) = fPath & "\" として、マクロ設定ブックと同じフォルダ内にあるPDFファイルをコピー元に指定しています。
	2.	条件に一致する交付用フォルダの検索
folder_acquisition関数内で、マクロ設定ブックと同じフォルダ内にあるサブフォルダを検索し、「########-#_交付用」という名前パターンに一致するフォルダを見つけます。

実行手順

1.	上記のコードをVBAエディタにコピーして実行してください。
	2.	マクロ設定ブックと同じフォルダ内に「交付用_A3」で終わるPDFファイルがあれば、そのファイルが「########-#_交付用」フォルダ内にコピーされます。

上記は生成AIの解答です。参考になれば幸いです。

これで、「検査時必要図書（正本）」フォルダを使わずに目的の動作が行えるはずです。何か不明点や追加で調整が必要であればお知らせください。

Excelのマクロについて教えてください。

PDFファイルをコピーではなく移動するためには、FileCopy の代わりに Name ステートメントを使ってファイルの場所を変更するように修正します。

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

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

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