- 締切済み
Excel VBAにて別のExcelファイルを開く
現在、ExcelファイルVBAにて別のExcelファイルを開こうとしています。FileSystemオブジェクトを利用してオープンはできるのですが、当然そのファイルをどなたかが利用していると「書き込みできません」とのメッセージが出てきます。これを回避するためにオープンするExcelファイルがすでに誰かに開かれているかを判定できる方法はございませんか？WSHやAPIを利用してもかまいません。以下にロジックを書いておきますので、どうかよろしくお願いいたします。緊急度は大変高いです。 'ErrorFileフォルダ内のエクセルファイルが存在するかを判定 Do Until fs.FileExists(buff) = False 'ErrorFile内のエクセルファイルを取得 Set f = fs.GetFile(buff) 'FileSystemオブジェクトでErrorFile\logフォルダ内の同一名称ファイルが存在するかを判定 If fs.FileExists(f.ParentFolder & "\log\" & f.Name) = True Then '存在していたら、ファイルを削除 ←この部分で誰かがファイルを開いているとエラー fs.DeleteFile f.ParentFolder & "\log\" & f.Name End If 'ErrorFileフォルダ内のファイルをErrorFile\logフォルダに移動 fs.MoveFile f.Path, f.ParentFolder & "\log\" & f.Name 'マクロが動作しているパスにErrorFileフォルダ内のエクセルファイル名をフルパスで取得 buff = ActiveWorkbook.Path & "\ErrorFile\" & Dir("ErrorFile/*.xls", vbSystem) Loop どうか、解決策を返信いただければ幸いです。
- bigfield555
- お礼率0% (0/3)
- Visual Basic
- 回答数3
- ありがとう数0
- みんなの回答 （3）
- 専門家の回答
関連するQ&A
- VBAで特定のフォルダ内のエクセルファイルをPDF
VBAで特定のフォルダ内のエクセルファイルをPDFに変換する作業しているのですが Filename:=ThisWorkbook.Path & "\" & Replace(f.Name, fs.GetExtensionName(f.Path), "pdf"), _ 出来上がったファイル名を コード_日付にしたく Filename:=ThisWorkbook.Path & "\" & ("コード") & Range("B9") & ("_") & Format(Now, "yyyymmdd") & ".pdf", _ に入力したのですがB9セルのコードが入りません。 どこが間違っているのでしょうか？
- 締切済み
- Visual Basic
- エクセルマクロ(vba)のFSO.OpenTextFileを利用したファイルへの追記について
FSOを利用して、特定のファイルがなければ、FSO.CreateTextFileを使ってファイルを作成して、ログを記入します。 特定のファイルがあれば、FSO.OpenTextFileを使って追記します。 ファイルが存在しないので新規でファイル作成を行ってからログを記入するのははうまくいくのですが、ファイルが存在するので、ファイルを開いて追記する場合ががうまくできません。 何が原因なのでしょうか？ 以下がそのプログラムです。 アドバイスをよろしくお願いします。 Dim excel_folder excel_folder = ThisWorkbook.Path excel_folder = excel_folder & "\log.txt" Set objShell = CreateObject("Wscript.Shell") Dim FSO Set FSO = CreateObject("Scripting.FileSystemObject") Dim stream, data_text If FSO.fileexists(excel_folder) Then Set stream = FSO.OpenTextFile(Filename:=excel_folder, IOMode:=ForAppending, Create:=True) Else: Set stream = FSO.CreateTextFile(Filename:=excel_folder, Overwrite:=True) End If data_text = "test" stream.writeLine (data_text) stream.writeLine (vbCrLf) stream.Close
- ベストアンサー
- オフィス系ソフト
- (Excel)VBA ファイルパスからファイル名を求める
Excel97のVBAで f-name = Application.GetOpenFilename() とするとf-nameにはオープンしたファイルのパスを含めたファイル名が代入されます。 これをそのまま Workbooks(f-name).close とすると、パス部分が余分なのかエラーになります。 そこで、このf-nameからファイル名(ブック名)だけ切り出す方法があれば教えてください。 もしくはこのオープンからクローズまでの流れとして良いやり方があれば教えてください。
- ベストアンサー
- オフィス系ソフト
- EXCEL フォルダだけを検索したい
ＥＸＣＥＬ２００３を使っています。 開いているファイルと同じフォルダ内に「テストフォルダ」があるかどうかを調べ、存在した場合に削除したいのですが、以下のような書き方ではフォルダだけでなくファイルも検索してしまうようです。 フォルダだけを検索するにはどうしたらいいでしょうか？ ＦＳＯでできることは分かっていますが、以下の方法で試してみたいのです。どうぞ宜しくお願い致します。 Sub test() my_path = ActiveWorkbook.Path & "\" f_name = Dir(my_path, 16) Do Until f_name = "" If f_name = "テストフォルダ" Then RmDir "テストフォルダ" End If f_name = Dir() Loop End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルの各シートに複数のtxtファイルを取り込む
はじめまして． Excel2013を用いたデータ整理でわからない部分があるため， 質問させていただきました． 同じフォルダに入った，複数(40個程度)のテキストファイルを， エクセルの複数のシートにそれぞれ取り込みたいと考えています． 具体的には，同じフォルダに入っている， A001.txt, A002.txt, A003.txt, .... というテキストファイル群を， Data_A.xlsxのSheet1にA001.txt Sheet2にA002.txt Sheet3にA003.txt といったように取り込みたいです． テキストファイルは， X_座標 Y_座標 X_速度 Y_速度 の四列で構成されており，タブでそれぞれ区切られています． 行数は20,000程度です． 以前，同様の質問をされた方の回答にありました以下のマクロを実行してみたのですが， ・タブで区切られず，一つのセルに四列分の文字が入力される． ・0の情報が消えてしまう． という二つの問題が発生しました． Sub ReadTextFiles() Const DirName = "C:\TEMP" '上記で指定されたフォルダに存在するファイルで、 '拡張子がtxtのものをすべて１シートとして読み込む Dim fs, dir, fc, f1, stream As Object Set fs = CreateObject("Scripting.FileSystemObject") Set dir = fs.GetFolder(DirName) Set fc = dir.Files For Each f1 In fc If LCase(fs.GetExtensionName(f1.Name)) = "txt" Then Worksheets.Add after:=Worksheets(Worksheets.Count) Sheets(Worksheets.Count).Name = f1.Name Set stream = f1.OpenAsTextStream Do While stream.AtEndOfStream <> True Cells(stream.Line, 1) = stream.ReadLine Loop stream.Close End If Next End Sub これらを解決した上で，ファイルを取り込む方法を教えていただきたいです． お手数ですが，よろしくお願い致します．
- ベストアンサー
- Excel（エクセル）
- ファイル名からフォルダを作成するscript
以前ここでタイトルのscriptを作っていただきsend toにいれて活用しています。 下記のように複数のファイルを選択した場合と単数の場合を別々に作ってあります。 そこでこれをひとつにまとめてどちらでも対応できるようなものにしたいのですが お知恵をお貸しください。 よろしくお願いします。 (Windows7Pro/64bit) // makefolder3.js fs = new ActiveXObject("Scripting.FileSystemObject"); args = WScript.Arguments; for (i = 0; i < args.Count(); i++) { basename = fs.GetBaseName(args(i)); path = fs.GetParentFolderName(args(i)).replace(/\\$/, ""); target = path + "\\" + basename; if (fs.FileExists(target) || fs.FolderExists(target)) WScript.Echo(target + "\n同名のファイル/フォルダがあります. 作成できません."); else fs.CreateFolder(target); } －－－－－－－－－－－－ // makefolder.js fs = new ActiveXObject("Scripting.FileSystemObject"); arg = WScript.Arguments(0); basename = fs.GetBaseName(arg); path = fs.GetParentFolderName(arg).replace(/\\$/, ""); target = path + "\\" + basename; if (fs.FileExists(target) || fs.FolderExists(target)) WScript.Echo(target + "\n同名のファイル/フォルダがあります. 作成できません."); else fs.CreateFolder(target); －－－－－－－－－－
- ベストアンサー
- その他(ソフトウェア)
- エクセルVBA 日付つきバックアップファイル
下記のような連番でバックアップファイルを作成するマクロを書きました。バックアップファイルの最上部に行を挿入し、そこにバックアップファイルの作成日とオリジナルのFullName(フルパス)を記したいのですがうまくいきません。 .Range("a1") = "保存時刻 ： " & Format(Now, "yyyy年mm月dd日hh時nn分") .Range("a2") = "オリジナル ： " & ActiveWorkbook.FullName ↑のような感じの情報を加えたいのです。 どなたか、下記のマクロにフルパスと作成日を付与し、マクロ実行後も作業中のブックをアクティブのままにして置く方法をおしえてください。 Sub MySave2() Dim FSO As New Scripting.FileSystemObject バックアップファイル名 = "C:\My Documents\エクセルBackUpｓ\" & Format(Date, "yyyymmdd") _ & ActiveWorkbook.Name If FSO.FileExists(バックアップファイル名) = False Then ActiveWorkbook.SaveCopyAs バックアップファイル名 Else Dim indn As Variant For indn = 2 To 1000 新 = "C:\My Documents\エクセルBackUpｓ\" & Format(Date, "yyyymmdd") _ & "-" & indn & ActiveWorkbook.Name If FSO.FileExists(新) = False Then ActiveWorkbook.SaveCopyAs 新 Exit For Else End If Next indn End If End Sub
- ベストアンサー
- Visual Basic
- Excel VBA で 保存
VBAマクロで 終了ボタンを押した時に あるシートを削除をし TEST2 と言う名前で保存したいのですが 保存したシートを開こうとすると強制終了してしまいます。どなたか詳しい方ロジックを見ていただけませんか？よろしくお願いします。 ちなみに Excel2000 です。 以下ロジック Dim fs As Object Dim w As Object strWK_SaveBmnFile = "c:\TEST2.xls" '' ------------------------------ '' strWK_SaveBmnFile ファイルの存在チェック '' ------------------------------ Set fs = CreateObject("Scripting.FileSystemObject") If fs.FileExists(strWK_SaveBmnFile) Then Kill strWK_SaveBmnFile End If Set fs = Nothing Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:=strWK_SaveBmnFile, _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False Windows("TEST2.xls").Activate Worksheets("DATA1").Select ActiveWindow.SelectedSheets.Delete Worksheets("DATA2").Select ActiveWindow.SelectedSheets.Delete ActiveWorkbook.Save Application.Quit
- 締切済み
- Visual Basic
- エクセルＶＢＡ でフォルダーの作成方法
エクセルＶＢＡでフォルダーの有無を確認する。 同じデレクトリ上で同一名のフォルダー、ファイルが存在するなら そのまま次の作業に進み、 デレクトリ、フォルダー、ファイルが存在しない場合は新規に 作成する。 新規に作成するのは MkDir "c:\white\DXF"で可能ですが、有無の判定の方法がわかりません。 初心者ですのでよろしくお願いします。 判定式がないと条件によってはエラーが生じます。
- ベストアンサー
- オフィス系ソフト
- エクセルVBAがエラーが出て作動しません。
以下のVBAコードを作成してみました。ところが、"Sub Sample1()"の部分が黄色く塗りつぶされ、"get folder"が選択された状態で”Subまたはfunctionが定義されていません”というエラーがでます。こちらですがどこを直せばうまくいくかご教示いただけないでしょうか？因みにファイルを探すコードを試している過程でたまたまネットでコードを見つけたので試ている段階です。 ーーーーーーーーーーーーーーーーーーーー Sub Sample1() Dim f As Variant, buf As String, cnt As Long, FSO As Object Set FSO = CreateObject("Scripting.FileSystemObject") With Application.FileSearch .NewSearch buf = InputBox("ZGBL_DLV_SOM_RP0442_SLS_ORD (39).xlsx") If buf = "" Or buf = "False" Then Exit Sub .Filename = buf buf = GetFolder("C:\Users\ytsuruok\Desktop\test") If buf = "" Then Exit Sub .LookIn = buf .SearchSubFolders = True ''サブフォルダも検索する If .Execute() > 0 Then For Each f In .FoundFiles cnt = cnt + 1 Cells(cnt, 1) = f ''パス＋ファイル名 Cells(cnt, 2) = FSO.GetFile(f).Name ''ファイル名 Cells(cnt, 3) = FSO.GetFile(f).ParentFolder ''パス Next f Else MsgBox "見つかりませんでした" End If End With Set FSO = Nothing End Sub ーーーーーーーーーーーーーーーー
- 締切済み
- Excel（エクセル）
