マクロの書き換え箇所がわかりません

どなたかご教示いただけましたら幸いです。

以前、
「_(アンダーバー)と-(ハイフン)に挟まれた文字列のフォルダを作成、同じ文字列を持つファイルを格納」
というマクロを組んでもらいました（下記コード記載します）。
今回その抽出条件を「_(アンダーバー)以前の文字列」に変更したいのですが、
マクロ素人のため、コードの書き換え箇所が分からず…。
どなたかご教示いただけませんでしょうか。

【以下コード】

Sub カラー名ごとにフォルダ分け()

Dim FPath, TargetFile, COLOR As String '変数宣言
FPath = Range("A1").Value 'FPathにa1のパスを代入
If FPath = "" Then Exit Sub 'もしパスがない(a1が空白)の場合マクロを中止します

Dim i As Long


Dim FSO As Object, f As Object
Set FSO = CreateObject("Scripting.FileSystemObject") 'FileSystemObjectを使えるようにします
For Each f In FSO.GetFolder(FPath).Files 'fにFilesコレクションを代入。For Each[配列orコレクション]がある限りnextまでの操作を繰り返す


TargetFile = f.Name 'TargetFileにファイル名(拡張子まで)を代入


'カラー名を取り出すための操作。要するに_と-に挟まれた文字列を取得したい
'InStrは指定した文字がその文字列の左から数えて何番目に出てくるかカウントしてくれます。
intdelm1 = InStr(TargetFile, "_") + 1 'ファイル名で、_(アンダーバー)が何文字目に出てくるか数えた数値を取得。
'それに+1することで、カラー名の開始位置数を取得、代入
intdelm2 = InStr(TargetFile, "-") '-(ハイフン)がが何文字目に出てくるか数えた数値を取得、代入

COLOR = Mid$(TargetFile, intdelm1, intdelm2 - intdelm1) 'Midは指定した文字列から文字を抜き出す開始位置、文字数設定することができます。

If FSO.FolderExists(FPath & "\" & COLOR) Then 'もし取得したカラーと同名のフォルダーがあれば、そこにファイルを移動します。
FSO.MoveFile f, FPath & "\" & COLOR & "\" & TargetFile


Else 'なければフォルダをつくり、そこにファイルを移動します

FSO.CreateFolder (FPath & "\" & COLOR) '取得したカラー名のフォルダをa1で指定したファイルの直下に生成します
FSO.MoveFile f, FPath & "\" & COLOR & "\" & TargetFile

End If
Next

'以下、作ったフォルダ内のファイル数をカウントして2以下の場合、ファイルをもとのフォルダに移動する操作。

Dim CO As Integer

For Each FO In FSO.GetFolder(FPath).SubFolders 'FOにSubFoldersコレクションを代入
CO = FSO.GetFolder(FO).Files.Count 'ファイル数カウント

If CO < 3 Then

For Each f2 In FSO.GetFolder(FO).Files '入れ子next
TargetFile2 = f2.Name

FSO.MoveFile f2, FPath & "\" & TargetFile2


Next

FSO.DeleteFolder FO

End If

Next



Set FSO = Nothing

End Sub


～ここまで～

何卒宜しくお願い致します。

No.2 ベストアンサー 回答者： fujillin 回答日時： 2020/06/17 14:33

こんにちは

ご質問以外の処理が全く同じで良いのかわかりませんが、ご提示のコードには十分なコメントが入れられているので、それを読んでも推測できそうに思いますが…

＞TargetFile = f.Name 'TargetFileにファイル名(拡張子まで)を代入
＞intdelm1 = InStr(TargetFile, "_") + 1 'ファイル名で、_(アンダーバー)が何文字目
＞intdelm2 = InStr(TargetFile, "-") '-(ハイフン)がが何文字目
＞COLOR = Mid$(TargetFile, intdelm1, intdelm2 - intdelm1)

の４行で、元のファイル名（＝TargetFile）から所定の文字列を抜き出しています（結果はCOLORに格納）。

＞コードの書き換え箇所が分からず…。
ですので、上記の部分（下３行）を変更なされば宜しいでしょう。
　intdelm1 = InStr(TargetFile, "_") - 1
　COLOR = Left(TargetFile, intdelm1)

※ 通常のVBAでは COLOR はシステム変数名（予約語）になっていると思いますので、他の変数名を利用なさった方が賢明かと思います。

この回答へのお礼

fujillinさん
こちらでもご回答いただき、ありがとうございます。
ご教示いただきました内容で書き換えましたら、希望の形で動作いたしました！

元々のコード内に丁寧なコメントがありますが、何しろ私がまるきり素人でして、
書き換えのルールといいますか、例えばhtmlタグのように対になるものや、
修正の範囲(ブロック)が分かっておらず、下手に触れないという情けない状況で
こういったご質問をさせていただきました。
スタートラインにも立っていない素人からの稚拙な質問に、ご気分を害されましたら失礼いたしました。

fujillinさんのご回答のおかげで、作業効率がぐんと上がりそうです。
誠にありがとうございました。

お礼日時：2020/06/17 17:10

No.1 回答者： iprjctkrr 回答日時： 2020/06/17 14:11

試していませんが、

intdelm1 = 1 'ファイル名の先頭位置
intdelm2 = InStr(TargetFile, "_") '_(アンダーバー)が何文字目に出てくるか数えた数値を取得、代入

の２行の書き換えでいけるような気が。
次の行の
COLOR = Mid$(TargetFile, intdelm1, intdelm2 - intdelm1)
でファイル名先頭からアンダーバー手前までが抽出されるはず。

この回答へのお礼

iprjctkrrさん

早々にご回答いただき、ありがとうございました！

ご教示いただいた内容の書き換えでは、うまく動作しませんでした。。。
(当方まるきりの素人なので、書き換えに失敗しているのかもしれません)
ご丁寧にコード内にコメントまで付けてご教示いただき、誠にありがとうございました＊

お礼日時：2020/06/17 17:04