VBSファイル名に特定文字がある場合
VBSで現在下記のようなコードを組んでいます。
動作としてはコードが組んであるVBSファイルにエクセルシートをドラック＆ドロップすると、ブックのパスが外れてファイル名の先頭に
シート内のセルE5の文字がつくようになっています。
やりたいのはその後の処理で
たとえば、ブックの名前が先頭から＃101-1ならAのフォルダへ移動
＃101-2ならBのフォルダへ移動という感じのことがしたいです。
つまりファイル名に-1や-2といった文字が先頭から数えて5番のところにあれば
その条件に合わせてファイルを指定のフォルダへ移動させたいということです。
正式には-が先頭から5文字目で数字が先頭から6番になります。
どのようにすればよいか教えてください。
Option Explicit
'Excel 2013 Later Japenese Version Available
'REF:
'REF:
'''///---定数の設定Set Enumuragion---///'''
Const PWD="aaaaa"
Const msoLanguageIDInstall = 1
'''///---変数の宣言---///'''
Dim objArgs, I , strFile
Dim objFile, objFolder,objPath,strScr
Dim xlApp,Wb
Dim objWShell : Set objWShell = Createobject("WScript.Shell")
Dim FSO : Set FSO = Createobject("Scripting.FileSystemObject")
'''///---ファイル処理開始 Start Document File Conversion---///'''
Set objArgs = Wscript.Arguments
For I = 0 to objArgs.Count-1
set objFile = FSO.GetFile(cstr(objArgs(I)))
If Lcase(Left(FSO.GetExtensionName(objFile.Path) ,4) )="xlsx" Then
Set xlApp =CreateObject("Excel.Application")
If xlApp.Version < 14 Then xlApp.Quit: Set xlApp = Nothing:wscript.Quit
xlApp.DisplayAlerts=False
xlApp.Visible = False
set wb=xlapp.WorkBooks.Open(objFile.Path,0,false,,PWd,,True,,false,false,,true,true)
if wb.HasPassword=true then
wb.Saveas objFile.Path,,"","",False
else
wb.Saveas objFile.Path,,Pwd,"",False
End if
Dim n
n = wb.Worksheets(1).Range("E5").Value & "_" & wb.Name
wb.close
FSO.GetFile(objFile.Path).Name = n
set wb=nothing
End If
Next
xlApp.DisplayAlerts=True
xlApp.Quit
set xlApp = Nothing
補足
HTMLファイルのあるフォルダ（オブジェクト、またはパス名）を得たいです。Set rootFolder = fso.GetFolder(".")だと、「ホームディレクトリ」と言うのでしょうか、「マイドキュメント」が出てきます。 ShellのCurrentDirectoryも、CurDir関数も、「マイドキュメント」を返しました。ExcelのThisWorkbook.Pathのような結果を望んでいます。 まったく初心者なので「ダブルクリックで起動」というところが分かりませんが、ボタンなのでワンクリックです。よろしくお願いします。