• ベストアンサー
※ ChatGPTを利用し、要約された質問です（原文：VBSでファイルをコピーして名前変更）

VBSでファイルをコピーして名前変更

watabe007の回答

  • watabe007
  • ベストアンサー率62% (476/760)
回答No.1

If Mid(objFile.name, 5, 2) = "-1" Then FSO.MoveFile objFile.path, "F:\A\" Else MsgBox objFile.Name & "　該当せず" End If ↓↓↓↓ Dim MovePath If Mid(objFile.name, 5, 2) = "-1" Then MovePath = "F:\A\" ElseIf Mid(objFile.name, 5, 2) = "-2" Then MovePath = "F:\B\" Else MsgBox objFile.Name & "　該当せず" End If FSO.CopyFile objFile.path, MovePath & "ABC" & Mid(objFile.Name,2, 5) & "_DEFG.xlsx" FSO.MoveFile objFile.path, MovePath

この回答がついた質問に戻る
回答 全件
ベストアンサー
修正 Else MsgBox objFile.Name & "　該当せ…
  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • 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 このコードをどのように変更すればできますでしょうか？

  • 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

  • VBS

    VBSであるファイルを１行ずつ読み込み、その読み込んだ値を ある別のファイルにリダイレクトしたいのですが、 どのように書けばよいか教えてください。 下記のように、echoでは出すことができるのですが、 ファイルにリダイレクトというのができません。 よろしくお願いします。 ==== sample shell ========================= Option Explicit On Error Resume Next Dim objFSO ' FileSystemObject Dim objFile ' ファイル読み込み用 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") If Err.Number = 0 Then Set objFile = objFSO.OpenTextFile("d:\dr1.txt") If Err.Number = 0 Then Do While objFile.AtEndOfStream <> True WScript.Echo objFile.ReadLine Loop objFile.Close Else WScript.Echo "ファイルオープンエラー: " & Err.Description End If Else WScript.Echo "エラー: " & Err.Description End If Set objFile = Nothing Set objFSO = Nothing ============================================================

  • VBSでファイル作成後、書き込みできない

    ファイルが存在している場合は、ファイルをオープンして書き込み、ファイルが存在していない場合は、ファイルを作成後、オープンして書き込みを行わせたいと考えています。 しかし、ファイルが存在していないとき、ファイルは作成されるのですが、『エラー：800A0046　書き込みできません。VBScript実行時エラー』が出て、書き込みができません。モードをWritingにしても同じでした。 お手数をおかけしますが、ご教示いただけますようお願いいたします。 Option Explicit '■ オブジェクトの宣言 Dim objFSO Dim objFile '■ 定数の宣言 Const strFileName = "C:\VBS\TEST.TXT" '■ 定数の宣言 '// ファイル入出力モード(8:追加書き込み) Const ForAppending = 8 Set objFSO = CreateObject("Scripting.FileSystemObject") If objFSO.FileExists(strFileName) Then WScript.Echo "ファイルが見つかりました" Else WScript.Echo "ファイルが見つかりませんでした" Set objFile = objFSO.CreateTextFile(strFileName) If IsObject(objFile) Then WScript.Echo "ファイルを作成しました" Else WScript.Echo "ファイルを作成できませんでした" WScript.Quit(1) End If End If '// ファイルのオープン Set objFile = objFSO.OpenTextFile(strFileName,ForAppending) objFile.WriteLine "2012/12/21,100,ブレーキパッド,35000"

  • VBSでデータベースへの接続

    dbon.cfgファイルにSQL　Serverへ接続のためのパラメータを設定しておき、それを読み込んでデータベースに接続しようとしていますが接続できません。 dbcon.cfgの中身は下記になっており、]以降のサーバー名、データーベース名を切り出すため、splitを指定しています。 値がわたっていないと思って、ループに"WScript.Echo strDBParm(intCnt)"を指定して中身を確認しようとしましたが、何も表示されません。 お手数をおかけしますがご教示いただけますようお願いいたします。 ----------------------------------------------- [server] サーバー名を指定 [database] データベース名を指定 [uid] [database]で指定したデーターベースに接続できるユーザ名を指定 [pwd] [uid]で指定したユーザーのパスワードを指定 ----------------------------------------------- -------------------------- [VBSスクリプト] Option Explicit Dim objFS Dim objFile Dim objADO Dim strDBParm(3) Dim intCnt Const strDBConCfg="C:\test\dbcon.cfg" Const ForReading = 1 Const TextCompare = 1 intCnt = 0 On Error Resume Next Set objFS = WScript.CreateObject("Scripting.FileSystemObject") If Err.Number <> 0 Then WScript.Echo "FSオブジェクトが作成できませんでした" WScript.Quit(1) End If Set objFile = objFS.OpenTextFile(strDBConCfg,ForReading) If Err.Number <> 0 Then WScript.Echo strDBConCfg & "を開く事ができませんでした" WScript.Quit(1) End If Do Until objFile.AtEndOfLine = True strDBParm(intCnt) = Split(objFile.ReadLine, "]", TextCompare) WScript.Echo strDBParm(intCnt) intCnt = intCnt + 1 Loop Set objADO = CreateObject("ADODB.Connection") If Err.Number <> 0 Then WScript.Echo "ADOオブジェクトが作成できませんでした" WScript.Quit(1) End If objADO.Open "Driver={SQL Server};" & _ "server=strDBParm(0); database=strDBParm(1); uid=strDBParm(2);　pwd=strDBParm(3);" If Err.Number <> 0 Then WScript.Echo "サーバーに接続できませんでした" WScript.Quit(1) End If objADO.Close Set objFS = Nothing Set objADO = Nothing

  • VBSで動画ファイルの時間を読み取る方法

    複数の動画ファイルをD&Dして、ファイル名に更新時間と動画時間（動画ファイルのプロパティのビデオの欄に表示される「長さ」という項目） をファイル名に追加するプログラムを書きたいと考えています。 更新時間を書き込む方法は http://www.vector.co.jp/soft/winnt/util/se501476.html のvbsを参考に作ることができました。 動画時間の読み取りに関しては http://q.hatena.ne.jp/1312251379 に書かれてあるのですが、うまくいきません。 ExtendedPropertyのところで、 オブジェクトでサポートされていないプロパティまたはメソッドです。 というエラーが出て実行することができません。 以下が、作りかけですが、作成したプログラムです。 WScript.Echo "Duration : [" & CStr(objFile.ExtendedProperty2("Duration")) & "]" ' 単位は 100ns のところをどのように書き換えれば良いか教えていただけないでしょうか？ Dim stArrayData Dim objParam Set objParam = WScript.Arguments 'D&Dでの読み込みを可能にする Dim objFs Set objFs = WScript.CreateObject("Scripting.FileSystemObject") ' 引数の全ファイルについてファイル名を変更する Dim objFile Dim dtLastModified Dim strLastModified Dim i Const FMTID_AudioSummaryInformation = "{64440490-4C8B-11D1-8B70-080036B11A03}" For i = 0 To objParam.Count - 1 If objFs.FileExists(objParam(i)) Then Set objFile = objFs.GetFile(objParam(i)) ' DateLastModifiedのフォーマットが環境によって違うかもしれないので ' いったんDate型にする dtLastModified = CDate(objFile.DateLastModified) If Hour(dtLastModified) < 10 Then strLastModified = strLastModified & "0" End If strLastModified = strLastModified & Hour(dtLastModified) If Minute(dtLastModified) < 10 Then strLastModified = strLastModified & "0" End If strLastModified = strLastModified & Minute(dtLastModified) ' ファイル名を設定 stArrayData = split(objFile.Name, ".") objFile.Name = stArrayData(0) & "-" & strLastModified & "." & stArrayData(1) WScript.Echo "FileName : [" & objFile.Name & "]" WScript.Echo "Duration : [" & CStr(objFile.ExtendedProperty2("Duration")) & "]" ' 単位は 100ns WScript.Echo "FMTID_AudioSummaryInformation,3 : [" & CStr(objFile.ExtendedProperty(FMTID_AudioSummaryInformation & " 3") ) & "]" ' 単位は 100ns Set objFile = Nothing End If Next Set objFs = Nothing Set objParam = Nothing

  • エクセルブックの複製(.vbs)

    「原紙」という名前のエクセルブックがあり、新しいお客様が増えたらそのブックを複製し、更にその時にダイアログを出してお客様の名前を入力し、それをファイル名にしたいです。 下記の.vbsファイルに元ファイルをドラッグすると連番を付けて複数作る、という目的でのコマンドを見つけました（これも凄いですが）。 もし改良出来る方がいたら教えてください。 ・コピー数の指定は必要ありません（毎回1ファイルのみ複製）。 ・ドラッグすると、ダイアログが出てきて入力したものがファイル名になる。 よろしくお願い致します。 If WScript.Arguments.Count = 0 Then WScript.Quit Dim fso Set fso = CreateObject( "Scripting.FileSystemObject" ) '--- コピー元ファイルの確認 filePath = WScript.Arguments.Item(0) If fso.FileExists( filePath ) = False Then WScript.Echo filePath & "がありません" WScript.Quit End If '--- コピー数の指定 Num = InputBox( filePath & vbNewLine & "をいくつコピーしますか") If IsNumeric( Num ) = False Then WScript.Echo "数値を入力してください。" WScript.Quit End If If Num > 999 Or Num < 1 Then WScript.Echo "数値は１～999で指定してください。" WScript.Quit End If Extention = "." & fso.GetExtensionName( filePath ) '--- ファイルチェック For i=1 To Num newFilePath = Replace( filePath, Extention, "_" & Right( "000" & i, 3) & Extention ) If fso.FileExists( newFilePath ) = True Then WScript.Echo "作成予定のファイル【" & newFilePath & "】が既に存在します。" WScript.Quit End If Next '--- ファイルコピー For i=1 To Num newFilePath = Replace( filePath, Extention, "_" & Right( "000" & i, 3) & Extention ) fso.CopyFile filePath, newFilePath Next

  • VBScriptでファイルからgoogle検索

    カレントディレクトリの.txtファイルを1行づつ読み込み、google検索したいのですが、ウィンドウが複数立ち上がってしまい1ウィンドウでタブで表示したいのですが上手くいきません。。と、テキストファイル名もタイトルタグで表示したいです。どなたかご存知でしたらご教授願います。以下、書きかけのソースになります。 ---------------------------------------------------------------------------------- use_ie Sub use_ie() 'Option Explicit 'On Error Resume Next Dim objFSO ' FileSystemObject Dim objFile ' ファイル読み込み用 Dim objWshShell ' WshShell オブジェクト If Err.Number = 0 Then Set objWshShell = WScript.CreateObject("WScript.Shell") Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") If Err.Number = 0 Then For Each FLO In objFSO.GetFolder(objWshShell.CurrentDirectory).Files path = FLO.Path If Right(path, 4) = ".txt" Then Set objFile = objFSO.OpenTextFile(path, 1) Do While objFile.AtEndOfStream <> True Set ie = CreateObject("InternetExplorer.Application") ie.Visible = True 'ie.Navigate "about:blank" 'ie.Document.Write "<title>path</title>" ie.Navigate "http://www.google.co.jp/" ',2048 '新規タブで開く waitIE ie ie.Document.getElementById("q").Value = objFile.ReadLine WScript.Sleep 100 ' 検索ボタンクリック ie.Document.all("btnG").Click waitIE ie strURL = "https://www.google.co.jp/" If ie.LocationURL = strURL Then ie.Quit Set ie = Nothing End If Loop objFile.Close End If Next Else WScript.Echo "ファイルオープンエラー: " & Err.Description End If Else WScript.Echo "エラー: " & Err.Description End If Set objFile = Nothing Set objFSO = Nothing Set objWshShell = Nothing Set ie = Nothing End Sub ' IEがビジー状態の間待ちます Sub waitIE(ie) Do While ie.Busy = True Or ie.readystate <> 4 WScript.Sleep 100 Loop WScript.Sleep 1000 End Sub

  • VBSでフォルダ、ファイル作成時のエラーコード

    フォルダ、ファイルが存在しないとき、作成するスクリプトをVBSで作成していますが、疑問点があるのでご教示ください。 objFSO.CreateFolder、objFSO.CreateTextFileを実行が、正常に行われた場合、 Err.Numberに0がセットされると思っていましたが、実際は違っていました。 objFSO.CreateFolderでフォルダが作成される場合、Err.Numberに13が返されます。 objFSO.CreateTextFileでファイルが作成される場合、Err.Numberに438が返されます。 このスクリプトを実行後、フォルダ、ファイルが存在しない場合、作成されることも確認しています。 フォルダ作成後、作成されたフォルダに対して、ファイルの作成／データの書き込みのアクセス権を拒否にすると返されるErr.numberに70がセットされることも確認しています。 なぜ、フォルダ、ファイルが作成された場合、0が返されないのかご存知の方がいらっしゃいましたらご教示ください。 また、その情報が記載されている書籍およびサイトがあれば、お教えいただければ、幸いです。 Option Explicit Dim objFSO Dim objFile Const strFolderName = "C:\VBS" Const strFileName = "C:\VBS\test.txt" On Error Resume Next Set objFSO = CreateObject("Scripting.FileSystemObject") If Err.Number = 0 Then WScript.Echo "FSOオブジェクトを作成しました" Else WScript.Echo "FSOオブジェクトを作成できませんでした" WScript.Quit(1) End If If objFSO.FolderExists(strFolderName) Then WScript.Echo "フォルダが見つかりました" Else WScript.Echo "フォルダが見つかりませんでした" If objFSO.CreateFolder(strFolderName) Then If Err.Number = 13 Then WScript.Echo "フォルダを作成しました" Else WScript.Echo "フォルダを作成できませんでした" WScript.Quit(1) End If End If End If If objFSO.FileExists(strFileName) Then WScript.Echo "ファイルが見つかりました" Else Script.Echo "ファイルが見つかりませんでした" If objFSO.CreateTextFile(strFileName) Then If Err.number = 438 Then WScript.Echo "ファイルを作成しました" Else WScript.Echo "ファイルを作成できませんでした" WScript.Quit(1) End If End If End If

  • VBSでファイル移動する部分を足したい

    取り敢えずスクリプト的には動いている (不要部分とか書き換え途中のままで動作問題なくても間違っている部分が有ると思います 　誤動作までは至らないので放置しているというだけです) のですがそのスクリプトに一部の通過ファイルを所定の位置に移動させたいと思います。 ソースの目的と理屈はTSファイルをBATからTSファイルをVBSに送りaviutilに処理させると言う物です。 最終的にTSファイルだけを移動させる形にしたいと言う感じです。 On Error Resume Next Set Args = WScript.Arguments Const ForReading = 1 '************TSファイル関連の設定************* ' テンポラリパス Const TMP_FOLDER = "E:\tsENC\mp4\" ' エンコードしたデータを出力するフォルダ(最後の文字は"\") Const OUTPUT_FOLDER = "E:\tsENC\mp4\" '*************ツール関連の所在************* ' 出力プラグイン番号(メニューの一番上が0) Const OUTPUT_PLUGIN = 0 ' 出力ファイルの拡張子 Const OUTPUT_EXT = ".mp4" ' BonTsDemuxのフルパス Const BonTsDemux_PATH = "E:\aviutil\aviutl99i8\BonTsDemux.exe" ' mmeのフルパス Const mme_PATH = "E:\aviutil\AVIUTIL\mme.exe" ' AviUtlのフルパス Const AVIUTL_PATH = "E:\aviutil\AVIUTIL\aviutl.exe" ' AviUtl Controlを置いてあるフォルダ(最後の文字は"\") Const AUC_FOLDER = "E:\aviutil\AVIUTIL\" ' = スクリプトと同じフォルダ Dim WHSHell, oExec, Fs Set WSHShell = WScript.CreateObject("WScript.Shell") Set Fs = CreateObject("Scripting.FileSystemObject") Function Auc(command, arg) Auc = WSHShell.Run("""" & AUC_FOLDER & "auc_" & command & ".exe"" " & arg, 2, True) End Function Dim i, tmp, tmpm2v, tmpwav, tmpgl, output, pid, hwnd ' AviUtlを起動 hwnd = Auc("exec", """" & AVIUTL_PATH & """") If hwnd = 0 Then Call WScript.Quit(-1) End if For i=0 to Args.Count - 1 tmp = TMP_FOLDER & Fs.GetBaseName(Args(i)) tmpm2v = tmp & ".m2v" tmpwav = tmp & ".wav" tmpgl = tmp & ".gl" output = OUTPUT_FOLDER & Fs.GetBaseName(Args(i)) & OUTPUT_EXT ' TSファイルを分割 Call WSHShell.Run("""" & BonTsDemux_PATH & """" & " -i """ & Args(i) & """ -o """ & tmp & """ -delay 167 -start -quit", 0, True) ' glファイルを作成 Call WSHShell.Run("""" & mme_PATH & """ -g -q """ & tmpm2v & """", 0, True) ' M2Vファイルを開く Call Auc("open", CStr(hwnd) & " """ & tmpm2v & """") Call WScript.Sleep(200) ' WAVファイルを開く Call Auc("audioadd", CStr(hwnd) & " """ & tmpwav & """") ' プロファイルを設定する Call Auc("setprof", CStr(hwnd) & " " & CStr(PROFILE)) Call WScript.Sleep(200) ' 出力プラグインから出力する Call Auc("plugbatch", CStr(hwnd) & " " & CStr(OUTPUT_PLUGIN) & " """ & output & """") Call WScript.Sleep(200) ' ファイルを閉じる Call Auc("close", CStr(hwnd)) ' テンポラリファイルを削除する Call Fs.Delete(tmpm2v) Call Fs.Delete(tmpwav) Call Fs.Delete(tmpgl) Next Dim Fname Dim Fname2 Dim FSO Set Fname = WScript.Arguments If Fname.Count = 0 Then WScript.Echo "ファイルをドラッグしてください。" WScript.Quit End If 'Set FSO = CreateObject("Scripting.FileSystemObject") Fname2 = FSO.GetFile(Fname(0)).Path FSO.MoveFile Fname2, move & FSO.GetFileName(Fname(0)) Set Fname = Nothing Set FSO = Nothing ' スクリプトで起動したAviUtlを終了する Call Auc("exit", CStr(hwnd))

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する
質問する