VBSでファイル名にシート内のセルの値を付け足す
現在下記のコードが書いてあるvbsにエクセルファイルをドラック＆ドロップをしてパスを外したり、つけたりしています。
その際に、投げ込んだエクセルファイルのファイル名の頭に
投げ込んだエクセルファイルのシート1のセルA1の値を付けたいと考えています。
例
パスのかかっている 間隔.xls
というファイルをVBSに投げ込むと
パスが外れ ファイル名が あいう間隔.xls
という名前に代わって保存される。コピーではなく投げ込んだシートの名前が変わって問題ありません。
あいう はシートのA1セルに入っていた文字です。
ブック内にシートは必ず1つしかありません。
Option Explicit
'Excel 2013 Later Japenese Version Available
'REF:
'REF:
'''///---定数の設定Set Enumuragion---///'''
Const PWD="paspas"
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) ,3) )="xls" 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
wb.close
set wb=nothing
End If
Next
xlApp.DisplayAlerts=True
xlApp.Quit
set xlApp = Nothing
このコードをどのように変更すればできますでしょうか？
お礼
できました。ありがとうございました。 下のコードでも前面表示できるようです。 こちらなら他のアプリケーションでもいけるかもしれません。 Set objWSH = CreateObject("WScript.Shell") objWSH.AppActivate objPPTApp.Caption