vbaでファイル移動

Question

前提・実現したいこと
「ファイル名と同じフォルダ名に移動 」

ここに質問の内容を詳しく書いてください。
VBAでファイル移動システムを作っています。
ファイル名と移動先のフォルダ名が同じだった場合、それぞれ移動(複数)できる機能を実装中に以下のエラーメッセージが発生しました。
※説明不足で申し訳ございません。追記させていただきます。
・移動したいファイルはpsdデータです。

資料1.psd　こちらを　資料1フォルダに格納させたいです。
同様に
資料2.psd　こちらを　資料2フォルダに格納
…　
こちらを繰り返します
拡張子があると反応しなかったので、一度拡張子(.psd)を外した状態の名前を抽出して
そちらを使ってmove.File で移動できればと思いました。

発生している問題・エラーメッセージ

Functionまたは変数が必要です。

該当のソースコード

Function 拡張子を取り除いたファイル移動() As FileSystemObject
    Dim myFileFullName As String
    Dim myFilePath As String
    Dim myFileName As String
    Dim myFileNameCut As String
    Dim fso As New FileSystemObject
    Dim f As file

    myFileFullName = ThisWorkbook.PATH & "*.psd"
    If myFileFullName = "*.psd" Then Exit Function
    myFileName = Dir(myFileFullName)
    
    Do While myFileName <> ""
    myFilePath = Left(myFileFullName _
        , Len(myFileFullName) - Len(myFileName))
    If InStr(myFileName, ".") = 0 Then
        myFileNameCut = myFileName
    Else
        myFileNameCut = Left(myFileName _
           , InStr(myFileName, ".") - 1)

  Debug.Print "選択されたファイル" & myFileFullName _
        & vbCr & "ファイル名：" & myFileName _
        & vbCr & "パス：" & myFilePath _
        & vbCr & "拡張子を除いたファイル名：" & myFileNameCut

  If Dir(myFileName) <> "" Then
        fso.MoveFile myFileFullName, ThisWorkbook.PATH & "\" & myFileNameCut
  Else: myFileFullName = myFilePath & "\" & myFileNameCut & ".psd"
        End If
  For Each f In fso.MoveFile(myFileFullName, ThisWorkbook.PATH & "\" & myFileNameCut)
 　　   Next
   　   End If
        myFileName = Dir() 
        Loop
        Set fso = Nothing
  End Function

試したこと

プロシージャを分けてCallで呼び出そうとしてみましたが、
「引数の省略ができません」と出ました。
(自分が理解できてない同じところで止まってます。。)
それと無限ループにもなってしまいました。

補足情報（FW/ツールのバージョンなど）

VBAまだよくわかってないので、コードは引用させてもらっています
SubとFunctionの使い分け、filesystemobjectを2種類同時に使う際に
皆さんどのようにされてますでしょうか。初歩的ですがCallで呼び出す場合の引数の書き方なども教えていただけると助かります。

Comments

[Zuishin]

VBA でする必要はありますか？

[otn]

とりあえず、インデントを正しくして、
無意味な空行を削除しましょう。

[1008]

ご返信いただきありがとうございます。
申し訳ございません、現在他の言語がわからないので、できればvba内でできると助かります。スクリプト使った方が早ければそちらも考えます

[Zuishin]

VBA もよくわかっていないということなので、未知の言語でも結局同じことなのではないかと思います。やろうとしていることが説明からもコードからもよくわからないので、日本語の説明を充実させて、どんなファイルをどのように動かすかの具体例を書けば回答が付きやすくなるのではないでしょうか。

[1008]

ご意見いただきありがとうございます。
稚拙な文章で大変お見苦しくなってしまい申し訳ございません。
少し追記させていただきました、ファイルと同じ名前のフォルダに移動したいという内容でした。

[Zuishin]

多分、例を挙げた方が早いと思います。どういうファイルがあり、どういうフォルダがあり、その中のどれを選択して実行すればどうなるかを、抽象的な言葉ではなく、実際のファイル名(例)を作って書けば伝わると思います。

[meg_]

エラーはどこで起きているのですか？
【追記】
コードを読んだところ色々と問題ありそうですね。。。

[meg_]

psdファイルがマクロブックと同じフォルダにある前提は良いとして、移動先のフォルダはどこにあるのでしょうか？　psdファイルがあるPC内のどこかにあるという前提でしょうか？（存在しない場合もある？？）

[1008]

移動先はブックと同じフォルダ内の、直下にあるフォルダです。存在しない場合もあります。
エラーは「functionまたは変数が必要です」と出ました。
fso.MoveFileの部分からできてないのかと思いました。理解ができてなく申し訳ございません。。

[tatsu99]

移動先のフォルダが存在しない場合は、まず、移動先のフォルダを作成し、そのあとで、そのフォルダへ移動する必要がありますが、そのようにしたいということでしょうか？

[1008]

移動先フォルダは既にある状態にします。
フォルダは事前に準備するので大丈夫です。
説明わかりにくくなってしまい申し訳ございません。

Answer 1

下記でどうでしょうか？

Option Explicit

Sub a()

    Dim fso As Object
    Dim f As Object
    Dim fileList As Collection
    Dim temp As String
    Dim i As Integer
    Dim a As Variant
    

    temp = Dir(ThisWorkbook.Path & "*.psd")
    Set fileList = New Collection
    Do While temp <> ""
        fileList.Add ThisWorkbook.Path & "\" & temp
        temp = Dir()
    Loop

    Set fso = CreateObject("Scripting.FileSystemObject")
    
    For i = 1 To fileList.Count
        If Dir(ThisWorkbook.Path & "\" & fso.GetBaseName(fileList(i)), vbDirectory) <> "" Then
            Name fileList(i) As ThisWorkbook.Path & "\" & fso.GetBaseName(fileList(i)) & "\" & Dir(fileList(i))
        End If
    Next i
    
    Set fso = Nothing
        
End Sub

Comments

[1008]

とてもきれいにまとめていただきありがとうございました。
また、説明がわかりにくく申し訳ございませんでした。
上記でやりたかったことができそうです。素晴らしいご回答ありがとうございます。