エクセルのマクロについて教えてください。

下記のマクロは先日教えて頂いたマクロで
指定セル値に表示された数字を検索して
指定フォルダ内にあるフォルダ名とが該当した場合に
マクロ設定ブックと同じ作業フォルダに移動できます。
例えば
指定セル値R18に「23045906」と表示され
検査フォルダの「6」のフォルダ内にフォルダ名「ABC23045906（回答）」とあり
指定セル「23045906」とフォルダ名の「ABC23045906（回答）」の内
「23045906」とが該当した場合に
作業フォルダにフォルダ毎移動です。
しかし、このマクロを実行すると
画像のエラーメッセージが表示され、コードの
「FSO.GetFolder(arrMoveFolders(0, i)).Move strDestPath & "\" & arrMoveFolders(1, i)」部分が黄色くなり
マクロが実行できません。
解決方法を教えてください。
現状のマクロ
Sub 行政回答フォルダ確認()
Dim i As Long
Dim FSO As Object
Dim strKeyword As String
Dim strFolderPath As String, strFolderName As String
Dim arrMoveFolders As Variant
Dim strOriginPath As String, strDestPath As String

If MsgBox("フォルダを検索しますか", vbOKCancel) <> vbOK Then Exit Sub

Set FSO = CreateObject("Scripting.FileSystemObject")
strKeyword = CStr(Sheets("青紙表").Range("R18").Value)
strOriginPath = "\\nas-sp01\share\確認部\■01_敷地照会回答書"
strDestPath = " ThisWorkbook.Path" 'ここに作業フォルダのパスを記入

If Right(strDestPath, 1) = "\" Then strDestPath = Left(strDestPath, Len(strDestPath) - Len("\"))

ReDim arrMoveFolders(0 To 1, 0 To 0)
For i = 0 To 9
strFolderPath = strOriginPath & "\" & i
strFolderName = Dir(strFolderPath & "\*" & strKeyword & "*", vbDirectory)
Do Until strFolderName = ""
If Replace(strFolderName, ".", "") <> "" Then
If arrMoveFolders(0, 0) <> Empty Then ReDim Preserve arrMoveFolders(UBound(arrMoveFolders, 1), UBound(arrMoveFolders, 2) + 1)
arrMoveFolders(0, UBound(arrMoveFolders, 2)) = strFolderPath & strFolderName
arrMoveFolders(1, UBound(arrMoveFolders, 2)) = strFolderName
strFolderName = Dir
End If
Loop
Next

If arrMoveFolders(0, 0) = Empty Then
MsgBox "該当フォルダがありません"
Exit Sub
Else
If MsgBox("該当フォルダがありました、フォルダを移動しますか", vbOKCancel) <> vbOK Then Exit Sub
End If

For i = 0 To UBound(arrMoveFolders, 2)
FSO.GetFolder(arrMoveFolders(0, i)).Move strDestPath & "\" & arrMoveFolders(1, i)
Next
End Sub
以上となります。
よろしくお願いいたします

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

• 大変困っています
  どなたか助けてください
  宜しくお願いします

    補足日時：2024/01/12 21:09

No.2 ベストアンサー 回答者： Qchan1962 回答日時： 2024/01/13 00:19

ぱっと見

①　
strDestPath = " ThisWorkbook.Path" 'ここに作業フォルダのパスを記入

strDestPath = ThisWorkbook.Path

②
arrMoveFolders(0, UBound(arrMoveFolders, 2)) = strFolderPath & strFolderName

arrMoveFolders(0, UBound(arrMoveFolders, 2)) = strFolderPath & "\" & strFolderName

説明を入れても意味が無い事を理解していますので割愛します
（未検証）

この回答へのお礼

回答ありがとうございます
何時も助けて頂き感謝いたします
早速試してみます

お礼日時：2024/01/13 07:32

No.1 回答者： fujillin 回答日時： 2024/01/12 23:51

こんばんは

ざっと見たところ、（確認してはいませんけれど）単にパスの区切り（＝バックスラッシュ）が抜けているだけではないかと思いますが・・・
質問者様が改変したのであれば、元に戻せば動作すると思います。
特殊なケースでのエラーとは思えませんので、最初からその内容であったのなら、そもそもが動作しないコードということになります。


＞マクロが実行できません。
＞解決方法を教えてください。
そのような場合には、作者にお尋ねになるのが通常です。
とは言え、拾ったもののようですので、それは元に戻して（＝捨てて）、改めて、ちゃんと「連絡の取れる」相手に依頼して作成して貰えば、きちんと動作するものを得ることができるでしょう。

仮に、「アイスが欲しい」のなら拾い食いなどせずに、お店に行きましょうということです。
そうすることで、後に何らかの修正を加えたいようなことが生じても、修正してもらうことも可能になります。

この回答へのお礼

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

お礼日時：2024/01/13 07:31