エクセルVBAでファイル書き込み時に上書きメッセージを表示する方法
- エクセルVBAを使用してファイル書き込みを行う際に、同じファイルが存在する場合に上書き確認メッセージを表示する方法について教えてください。
- 現在のコードでは、Scripting.FileSystemObjectを使用してファイルを作成していますが、上書きメッセージを表示するにはどのように変更すれば良いでしょうか？
- ダイアログを使用して上書き確認メッセージを表示するように改善したいです。
- ベストアンサー
エクセルvbaでファイル書き込みのとき同じファイルがある場合に\"上書きしますか？\"というメッセージをだすには？
エクセルvbaでファイル書き込みのとき同じファイルがある場合に"上書きしますか？"というメッセージをだすには、どのようにやればよいでしょうか？ ダイアログで上書きするときにメッセージを出すようにしたいのです。 現在は、 Dim fo As New Scripting.FileSystemObject Dim ts As TextStream Dim myDir As String Dim myFileDir As String myDir = ThisWorkbook.Path myFileDir = myDir & "\a.txt" 'ここにファイルを探すコードを埋め込んでいます。 Set ts = fo.CreateTextFile(myFileDir, False) よろしくお願いします。
- whatsnew
- お礼率50% (41/81)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
If ファイル有り Then If MsgBox("上書きしますか？", vbYesNo) = vbYes Then Set ts = fo.CreateTextFile(myFileDir, True) Else 'Exit Sub は 必要に応じて他の処理に替えてください。 Exit Sub End If Else Set ts = fo.CreateTextFile(myFileDir, False) End If
関連するQ&A
- Excel VBA
外部からモジュールを読み込めるようにしました。 ーーーーーーーーーーーーーーーーーーーーー Sub moduleImport_All() 'インポートしたいファイルのあるフォルダを指定 Dim sImportPath As String sImportPath = "C:\VBA\module\" 'FileSystemObjectの作成 Dim oFso As Object Set oFso = CreateObject("Scripting.FileSystemObject") 'フォルダオブジェクトを取得 Dim oDir As Object Set oDir = oFso.GetFolder(sImportPath) 'ファイル名を順次取得 Dim fFile As Object For Each fFile In oDir.Files 'ファイルの拡張子を取得 Dim sExt As String sExt = oFso.GetExtensionName(fFile.Name) '拡張子からモジュールだけを取得、インポート Select Case LCase(sExt) Case "bas", "cls", "frm" '指定のモジュールをインポート ThisWorkbook.VBProject.VBComponents.Import sImportPath & fFile.Name End Select Next MsgBox "完了" End Sub ーーーーーーーーーーーーーーーーーーーーー しかし、上書きがなされない為、1,2,3とモジュールが増えてしまいます。 読込みたいフォルダ内のファイルと同じ名前であれば全て上書きするにはどのように修正したらよいでしょうか？
- 締切済み
- Visual Basic
- ファイルへの書き込み
いままでPrintメソッドを使って書き込みしていました。 ちょっと志向を変えてオブジェクト（？）をつかってプログラミングしています。 ファイルの書き込みでつまづいたので教えてください。 真ん中くらいに質問文があります Dim objFileSystem As Object Dim objFile As Object Dim strFileName As String Dim strBuff As String ' 読み込むファイル名 strFileName = "Readme.txt" ' FileSystemObjectオブジェクトへの参照 Set objFileSystem = CreateObject("Scripting.FileSystemObject") ' ファイルを開く Set objFile = objFileSystem.OpenTextFile(strFileName) ' ファイルの最後に達するまでループ strBuff = strBuff + naiyo.Text 'ここで質問。この書き方だとファイルモードが不正とエラーが出ます。 'この部分どう書けばよいのでしょうか？ objFile.writeline (strBuff) ' ファイルを閉じる objFile.Close ' オブジェクトを解放 Set objFileSystem = Nothing Set objFile = Nothing オブジェクト変数（というのでしょうか(^^ゞ）を使ったファイルの書き込み方教えてください。
- ベストアンサー
- Visual Basic
- FSOでエクセルファイルを作成したい
FSOでエクセルファイルを作成したいのですが、 ファイルの作成はできますが、作成したファイルが開けません。 Sub 新規Excelファイルを作成する() Dim MyFile As String Dim myFSO As Object MyFile = "管理簿.xlsx" Set myFSO = CreateObject("Scripting.FileSystemObject") With myFSO.CreateTextFile("C:\" & MyFile) .Close End With Set myFSO = Nothing End Sub で、エラーにならずうまくいっています。 が、その出来上がったファイルを開こうとすると 「ファイル形式またはファイル拡張子が正しくありません」 と言う旨のメッセージが表示されます。 何が間違ってますか？ よろしくお願いします。
- ベストアンサー
- Excel（エクセル）
- 位置の指定をすることは可能ですか？
VBAでテキストファイルを生成するコードを作ったのですが その際位置の指定をすることは可能ですか？ Sub test() Dim myFSO As New FileSystemObject Dim ts As TextStream Dim MyFileName As String Dim MyPath As String MyPath = MyDesktop & "\" MyFileName = "test.txt" Set myFSO = CreateObject("Scripting.FileSystemObject") Set ts = myFSO.CreateTextFile(MyPath & MyFileName, True) CreateObject("Shell.Application").ShellExecute MyPath & MyFileName 'ここで位置の指定をしたい Set ts = Nothing Set myFSO = Nothing End Sub こんな感じのコードは作成しました。 With MyFileName .Top = 100 .Left = 100 End With みたいな感じで位置の指定は可能ですか？ APIを使わないと無理ですか？
- ベストアンサー
- オフィス系ソフト
- Excel VBAファイルがない場合メッセージ表示
ExcelVBAでプログラムを実行させたときに2つのファイルを参照します。 (1)結果コピー先ファイル (2)データ元ファイル この2つのファイルのうち、いずれかがなかった場合にメッセージを表示させたいのですが思うように表示されません。 以下のように動作させたいのですがうまくいきません。 (1)2種類のファイルがないときには両方のメッセージを 1つの画面に表示したい。 (2)どちらか一方のファイルがないときには、 エラーメッセージを表示させエラーのないファイルを 表示させない。 ※いろいろ試したら(a)がないメッセージが表示されたが、 (b)のファイルが表示された。 (3)正常に処理が終了した場合は、完了メッセージを表示したい。 途中まで書いてみたコードは以下の通りです。 ※実行コードは中略します。 '////////////////////////////////////////////////////// Sub test1() Dim sMsg As String Dim sMyDir As String sMyDir = ThisWorkbook.Path & "\" Dim Ws As Worksheet Dim vTgYear As Variant Dim Wb As Workbook Set Wb = Workbooks("算出プログラム.xls") Set Ws = Wb.Sheets("入力内容") vTgYear = Ws.Range("D17").Value With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim sWbkName As String, StName As String Dim wbk結果1 As Variant sWbkName = "3_結果\結果.xls" StName = "Sheet1" Dim sWbkSubName As String sWbkSubName = "1_算定表\" & vTgYear & "_算定表.xls" Dim Kname As String, Mname As String Kname = sMyDir & sWbkName Mname = sMyDir & sWbkSubName Dim buf As String On Error GoTo myError Open sMyDir & "3_結果\結果.xls" For Input As #1 Line Input #1, buf Close #1 On Error GoTo ErrorHandler2 If Dir(Mname) <> "" Then Workbooks.Open Filename:=Mname, Password:="aaaaa" Else Dim Wb1 As Workbook Set Wb1 = Workbooks("結果.xls") Set wbk結果 = Wb1.Sheets(StName) Dim wbkA As Variant Dim sShtName As String sShtName = "地域1" Dim Wb2 As Workbook Set Wb2 = Workbooks(vTgYear & "_算定表.xls") Set wbk地域A = Wb2.Sheets(sShtName) wbk結果.Range("F9:N9").Value = wbk地域A.Range("AB7:AK7").Value wbk結果.Range("F10:N10").Value = wbk地域A.Range("AB51:AK51").Value wbk結果.Range("F11:N11").Value = wbk地域A.Range("AB95:AK95").Value wbk結果.Range("F12:N12").Value = wbk地域A.Range("AB139:AK139").Value wbk結果.Range("F13:N13").Value = wbk地域A.Range("AB183:AK183").Value wbk結果.Range("F14:N14").Value = wbk地域A.Range("AB227:AK227").Value wbk結果.Range("F15:N15").Value = wbk地域A.Range("AB271:AK271").Value wbk結果.Range("F16:N16").Value = wbk地域A.Range("AB315:AK315").Value ≪後略≫ Application.DisplayAlerts = False wbk結果1.SaveAs Filename:=sMyDir & "3_結果\" & vTgYear & "_テスト.xls" ' Application.DisplayAlerts = True With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With Workbooks(vTgYear & "_算定表.xls").Close SaveChanges:=False MsgBox "計算期間" & "「" & kenko_Label_10 & "」で" & vbLf & "ファイルを作成しました。", vbInformation Close #1 Exit Sub myError: MsgBox "出力先の「結果_健康寿命」ファイルが存在しません。" & _ vbLf & "処理を終了します。", vbOKOnly + vbExclamation Exit Sub ErrorHandler2: MsgBox "指定年の「長野県健康寿命算定表」" & _ vbLf & "ファイルが存在しません。処理を終了します。", vbOKOnly + vbExclamation End If End Sub '////////////////////////////////////////////////////// メッセージ画面以外は正常に動作することを確認しています。 メッセージ画面について教えてください。 素人で申し訳ありませんが、よろしくお願い致します。
- ベストアンサー
- Visual Basic
- VBAで大量のテキストファイル結合ができません
いつもお世話になっております。 icevainと申します。 早速ですが、 VBAで大量のテキストファイルを結合したいのですが 下記コードを実行すると、 ある一定量のファイルまでは期待通り結合されるのですが、 それを超えると途中でコマンドプロンプトの黒い画面が出て止まってしまいます。 結合ファイル（out.txt）を見ると途中まで（70ファイル程度）は結合されています。 ちなみに結合するファイルはすべて3行、文字数は300程度です。 'ここから----------------------------------------------------- Private Sub CommandButton1_Click() 'コマンドプロンプト用のオブジェクトWindows Script Dim wshell As New IWshRuntimeLibrary.WshShell Dim retbuf As WshExec Dim cmdline As String Dim v0 As String Dim v1 As String Dim v2 As String Dim v3 As String Dim v4 As String v0 = "copy " v1 = ThisWorkbook.Path & "\temp\*.txt" v1 = """" & v1 & """" v2 = " " v3 = ThisWorkbook.Path & "\out.txt" v3 = """" & v3 & """" cmdline = v0 & v1 & v2 & v3 'コマンド を 実行 Set retbuf = wshell.Exec("%ComSpec% /c " & cmdline) 'コマンド の 実行 終了 まで 待機 Do While retbuf.Status = 0 DoEvents Loop End Sub 'ここまで----------------------------------------------------- どなたかお知恵お貸しいただけないでしょうか。 よろしくお願いいたします。
- ベストアンサー
- Excel（エクセル）
- VB6でUTF-8ファイルの読取りを
ＶＢ６で、日本語と簡体文字の混在するUTF-8コードのファイル "c:\testfile.txt" を読み取って変数に入れて、取り扱える実例を作っていただけませんでしょうか？ ＶＢ６では、FileSystemObjectなどを使うようですが、さっぱり使い方が分りません。私は昔、コボルやフォートランをかじったことがあり、ＶＢの基礎は使えるのですが、FileSystemObjectなどはどうも分りません。Visual Basic.NETを使えばUTF-8も簡単に使えるようですが、難しくて歯が立たずVB6でやろうとしています。 ご参考；「次のコードは、FileSystemObject を使って、ファイルの読み取りまたは書き込みに使用できる TextStream オブジェクトを取得する例です。」とあるのですが、ファイルから変数に読み取るために使うには如何使えば良いのか、分りません。 Dim fso, MyFile Set fso = CreateObject("Scripting.FileSystemObject") Set MyFile = fso.CreateTextFile("c:\testfile.txt", True) MyFile.WriteLine("This is a test.") MyFile.Close また、下記は「指定したファイルを開き、開いたファイルの読み取り、または追加書き込みに使用できる TextStream オブジェクトを返します。」とあるのですが、これとの関係もよくわかりません。 object.OpenTextFile(filename[, iomode[, create[, format]]]) よろしくお願いいたします。
- ベストアンサー
- 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 出力について
txtファイルの出力をしたいのですが 調べながらやっていたのですがよくわかりませんでした。 あまり時間が取れない為 コードの記述方法を教えてください。 vbaの処理を行ってできたstrCompSheetNmのSheetがあります。 このSheetのデータを出力したいのです。 またこのSheetの行数は非固定になります。 出力元をどこかで指定してあげないといけないのかと思うのですが 記述方法がわからず いろいろなサイトを参考にしながらやってみても 内容が空のファイルができあがったりしてました。 出来たら 出力時 同名のファイルがあった場合 上書き又はファイル名を変更できるようにしたいのです。 いろいろ書きなおした上で下記の状態でとまっております。 ご回答のほう宜しくお願い致します。 不慣れでもうしわけないです。 現状 Dim SaveFileName As Variant Dim wScriptHost As Object, strInitDir As String Set wScriptHost = CreateObject("WScript.Shell") ChDir wScriptHost.SpecialFolders("Desktop") 'Dim YeDate As String 'YeDate = Format(Date, "yyyymmdd") SaveFileName = Application.GetSaveAsFilename(Format_ (Date, "yyyymmdd"), "テキストファイル(*.txt),*.txt,_ CSVファイル(*.csv),*.csv") If SaveFileName <> False Then Dim FlNum As Integer Dim GYO As Long Dim GYOMAX As Long FlNum = FreeFile Open ThisWorkbook.Path & SaveFileName For Output As FlNum GYO = 1 Do Until GYO > GYOMAX Print #FlNum, GYO = GYO + 1 Loop Close #intFF Else MsgBox "キャンセルがクリックされました。", vbInformation End If
- 締切済み
- その他（プログラミング・開発）
- エクセルからUTF8でファイルを出力する方法。
エクセルのマクロでシートの内容をXMLに変換して出力するマクロを作成しています。ファイルオブジェクトを利用しているのですが、保存されたドキュメントがシフトJISとなってしまい、そのまま利用できません。 UTF8形式で保存したいのですが、どなたかサンプルなど提供していただけませんでしょうか？ 以下、作成中のサンプルコードです。 ---- Sub XMLMake(wksheetname As String) '列名取得 'ファイルオブジェクト作成 Dim objFile As Object Dim objTextFile As Object Dim strFileName As String Set objFile = CreateObject("Scripting.FileSystemObject") Set objTextFile = objFile.CreateTextFile("d:\" & wksheetname & ".xml", True) 'ルートノード作成 objTextFile.WriteLine ("<DATA>") 'ルートノード閉じ objTextFile.WriteLine ("</DATA>") 'ファイルオブジェクト保存 objTextFile.Close MsgBox ("ファイルを作成しました。:" & wksheetname & ".xml") End Sub
- 締切済み
- オフィス系ソフト
お礼
有難うございます。