作成者	カテゴリ	返答の対象		公開
TAM 03/06/2001 06:20 PM		既存Excelファイル書出時のファイル置き換え確認

こんなかんじで指定したファイルが既存か新規か判定が
できると思います。

確かDir()って渡したパス＆ファイル名が無ければヌルを
返したような気がしたんで・・・。

間違っていたらゴメンなさい。

--------------------------------------------------
Sub Initialize
　Dim ofn As OPENFILENAME
　Dim xlsBook As Variant 'EXCELファイル
　Dim xlsSheet As Variant 'EXCELシート
　Dim result As Integer
　Dim filename As String

　'OPENFILENAME定義
　ofn.lStructSize = Len(ofn)
　ofn.hwndOwner = 0
　ofn.hInstance = 0
　ofn.lpstrFilter = "Excel Files(*.xls)" & Chr$(0) & "*.xls" & Chr$(0) & Chr$(0)
　ofn.lpstrCustomFilter = ""
　ofn.nMaxCustFilter = 0
　ofn.nFilterIndex = 0
　ofn.lpstrFile = String$( 255, Chr$(0) )
　ofn.nMaxFile = 256
　ofn.lpstrFileTitle = String$( 255, Chr$(0) )
　ofn.nMaxFileTitle = 256
　ofn.lpstrInitialDir = ""
　ofn.lpstrTitle = "ファイルを選択"
　ofn.Flags = OFN_PATHMUSTEXIST
　ofn.nFileOffset = 0
　ofn.nFileExtension = 0
　ofn.lpstrDefExt = ""
　ofn.lCustData = 0
　ofn.lpfnHook = 0
　ofn.lpTemplateName = ""

　'APIからダイアログ呼出
　result = GetOpenFileName( ofn )
　If result=False Then Exit Sub

　'選択されたファイル名を取得
　filename$ = ofn.lpstrFile

　'filename$が見つからなければヌル
　If Dir(filename$)="" Then
　　'ファイルが存在する為、既存のファイルを上書
　　Set xlsBook = GetObject(filename$,"Excel.Sheet")
　Else
　　'ファイルが存在しないので新規作成
　　Set xlsBook = CreateObject("Excel.Sheet")
　End If

　Set xlsSheet = xlsBook.Worksheets(1)
　
　　《　中略　》

　Call xlsBook.SaveAs(filename$)

End Sub
--------------------------------------------------