プロが教えるわが家の防犯対策術!

マクロコードを作業中のフォルダに変更する方法を教えてください。
マクロ
Sub ファイルコピー()
Dim myPath(2) As String
Dim FileName As String
' ファイル元保管場所
myPath(1) = "C:\Users\Desktop\テスト物件\審査\"

' ファイル貼り付け先
myPath(2) = "C:\Users\Desktop\テスト物件\検査\"
FileName = Dir(myPath(1) & "*(交付用).pdf")
Do While FileName <> ""
FileCopy myPath(1) & FileName, myPath(2) & FileName
FileName = Dir
Loop

End Sub
が有ります。
このコードでは
' ファイル元保管場所
myPath(1) = "C:\Users\Desktop\テスト物件\審査\"
' ファイル貼り付け先
myPath(2) = "C:\Users\Desktop\テスト物件\検査\"
になっておりますが、「審査」「検査」それぞれのフォルダは作業フォルダ内になります。
例えば作業フォルダ名「北海 太郎邸新築工事」や「北海 花子邸新築工事」等々その各作業フォルダ内に必ず「「審査」「検査」があります。
ファイル元保管場所とファイル貼り付け先の指定フォルダを作業中のフォルダに変更する方法を教えてください。
よろしくお願いします。

「エクセルのマクロについて教えてください。」の質問画像

質問者からの補足コメント

  • 回答ありがとうございます
    物件フォルダは各物件ごとの名前等で決めてます
    よろしくお願いします

      補足日時:2023/07/02 14:28
  • 私が行いたいのは
    先ず 最初に各物件ごとのフォルダがあります(フォルダ名はフォルダごとに変更になる為固定できません)
    そのフォルダフォルダの中にサブフォルダで
    審査 検査 前審査 の3つのフォルダがありますが 物件によっては 前審査フォルダが無い場合もあります
    マクロを設定しているエクセルファイルは必ず審査フォルダ内にあります
    審査フォルダ内にあるマクロファイルを開き
    マクロを実行した時に
    サブフォルダにある 前審査フォルダを削除したいのですが
    前審査フォルダが無い場合も想定して
    コードの最初に
    On Error Resume Next
    を設定しました
    よろしくお願いします

      補足日時:2023/07/02 17:26

A 回答 (4件)

なさりたい事が良く解らないですが



このコードはファルダ内にあるPDFに対して条件に合った場合
FileCopyをするコードです

構造が限定されているのなら
作業中のファルダパスを取得する事で可能です

作業中とはどのような作業なのか
ファイルを開いて操作していると言う事でしょうか
VBAで何だかの操作をフォルダ内ファイルに対して行ってい状態ですか?
このVBAのブックが作業中フォルダにあるとか・・・

(Excelブックなら簡単ですが)PDFファイルを手動で開いているだけとかになると他のアプリケーションのWindowからpathを取得する事になり難しいですね・・・これは該当しないと言う事で進めると

作業中もしくはVBA実行ブックからパスを取得して フォルダパスとファイル名を作成してPDFエキスポート(又はFileCopy)すれば出来ると思います

VBA実行ブックが テスト物件ファルダにあるのなら VBA実行ブックからパスを取得して

myPath(1) =ThisWorkbook.Path & "\審査\"
myPath(2) =ThisWorkbook.Path & "\検査\"
となります

VBAなどでテスト物件ファルダにあるブックを開いているのなら
Workbooks.Open 直後に グローバル変数など(セル値)に代入しておく
myPath(1) =ActiveWorkbook.Path & "\審査\"
myPath(2) =ActiveWorkbook.Path & "\検査\"

既に開いている テスト物件ファルダにあるブックが作業中ブックなら
Dim bk As Workbook
For Each bk In Workbooks
If bk.Path Like "*新築工事" Then
myPath(1) = bk.Path & "\審査\"
myPath(2) = bk.Path & "\検査\"
End If
Next bk

思い付く事を書きましたが
いずれにしても \審査 \検査 各フォルダが存在している事は
保証されていませんので

Dim f As Object
Dim n As Integer
With CreateObject("Scripting.FileSystemObject")
For Each f In .GetFolder(ThisWorkbook.Path).SubFolders
Select Case Mid(f.Path, InStrRev(f.Path, "\") + 1)
Case "審査"
myPath(1) = f.Path & "\"
n = n + 1
Case "検査"
myPath(2) = f.Path & "\"
n = n + 1
End Select
If n = 2 Then exit for
Next f
End With

の様に実際にサブフォルダを探してmyPathの値やnの値など取得できているかとか最終チェックをする方が良いと思われます
    • good
    • 0
この回答へのお礼

色々とありがとうございます
説明が悪く申し訳ありません
早速試してみて
又 ご連絡させていただきます
又 昨日PDFファイル名を変更する質問をさせて頂き 教えていただいたコードを設定してみましたがエラーが出て実行出来なかったと
補足させて頂きましたので
そちらもよろしくお願いします

お礼日時:2023/07/02 17:17

>マクロを設定しているエクセルファイルは必ず審査フォルダ内にあります



Sub フォルダ削除()
On Error Resume Next
Dim FSO As Object
Dim Adr As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Adr = FSO.GetParentFolderName(ThisWorkbook.Path)
FSO.DeleteFolder Adr & "\前審査"
End Sub
    • good
    • 0
この回答へのお礼

ありがとうございました
早速試してみます
後ほどご連絡させていただきます

お礼日時:2023/07/02 17:33

フォルダを選択させて、それと「\検査\」「\審査\」を結合させると良いと思います。


http://officetanaka.net/excel/vba/tips/tips39.htm
    • good
    • 0
この回答へのお礼

ありがとうございます
参考にさせて頂きます♪

お礼日時:2023/07/02 14:44

「作業中のフォルダ」は、どのようにして決めたいですか?

    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!