こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

このコードをどのように変更すればできますでしょうか?

投稿日時 - 2018-11-02 21:31:56

QNo.9553839

すぐに回答ほしいです

質問者が選んだベストアンサー

> wb.Saveas objFile.Path,,"","",False
> else
> wb.Saveas objFile.Path,,Pwd,"",False
> End if
Dim n
n = wb.Worksheets(1).Range("A1").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

投稿日時 - 2018-11-02 22:59:29

お礼

目的の動作が行えました。
非常に助かりました。ありがとうございました。

投稿日時 - 2018-11-02 23:43:33

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問