フォルダ名を変更するプログラム

質問

「変換前」というフォルダに200ほどのPDFファイルがあります。
フォイル名はダウンロードした日時によってランダムに数字が並びますが、
必ずその一部に100種類の英語が含まれています。
その英語、100種類はすでにわかっています。

そのフォルダ内のPDFの英語のみ残した状態でファイル名をつけたいです。
一気に作業する方法はございませんか？（VBSなど…全く知識がなく）

◼︎変換前 （フォルダ）
005725ABC57915.pdf
173596DEF56975.pdf
353986GHI56885.pdf

◼︎変換後 （フォルダ）
ABC.pdf
DEF.pdf
GHI.pdf

このようにいっぺんに変換したいです。
ファイル名の一部にABCとつくファイルを見つけ出し、
ABCというファイル名に変更する…という手順に
なるのでしょうか？知識なく…困っております。

どなたか初心者でもわかるように教えていただけるとありがたいです。
よろしくお願い申し上げます。

回答No.2

NotFound404

出来はいまいち（さん？）ですが・・・。
下記コードをメモ帳などにコピペッタンして拡張子をVBSで保存してください。
保存先はあなたの『変換前』フォルダです。
返還前_new フォルダに掃除の終わったファイルが保存されます。
アルファベット５２文字だけを抜き出しています。
もし掃除が終わった時にファイル名が重複する場合は連番を振っています。
返還前フォルダ中にサブフォルダがあっても処理していません。

Dim oSh, oFs
Dim fFrom, fN
Dim fTo, fNto, fTmp, fTmp2
Dim i, j
Set oFs = CreateObject("scripting.filesystemobject")
Set oSh = CreateObject("Wscript.Shell")
Set fFrom = oFs.GetFolder(oSh.currentDirectory)

If oFs.FolderExists(fFrom & "_new") = False Then
oFs.CreateFolder fFrom & "_new"
End If

For Each fN In fFrom.Files
fNto = ""
If oFs.GetExtensionName(fN) = "pdf" Then
fTmp = oFs.GetBaseName(fN)

For i = 1 To Len(fTmp)
If InStr(1, "abcdefghijklmnopqrstuvwxyz", Mid(fTmp, i, 1), vbTextCompare) > 0 Then
fNto = fNto & Mid(fTmp, i, 1)
End If
Next

fTmp2 = fNto
j = 0
Do Until oFs.FileExists(fFrom & "_new" & "\" & fTmp2 & ".pdf") = False
j = j + 1
fTmp2 = fNto & j
Loop
oFs.CopyFile fN, fFrom & "_new" & "\" & fTmp2 & ".pdf"
End If
Next
MsgBox "終了しました"

お礼

ありがとうございました。
トライしてみます！

回答No.1

sora1515

質問そのままぐぐったら答え出ますね・・・
と書こうとしたら質問すら間違えてた罠！

こちらをどうぞ。
ファイル名一括変更
http://www.vector.co.jp/soft/win95/util/se241103.html

ヘルプ→正規表現の使用例→数字部分のみ取り出し→\d+
とやさしい解説もありました。

お礼

早速ありがとうございます。
社内セキュリティー上ダウンロードができないもので…
自作できる方法はないものでしょうか。

すみません。。。。