タイトル | : VBからExcel起動でファイルを開く |
記事No | : 14747 |
投稿日 | : 2010/06/11(Fri) 15:23 |
投稿者 | : はち |
VBからExcelを起動し、ファイルを開き、シートし、書き込むのを作っています。 Excelを直接起動し、ファイルを開いた状態で、VBからExcelを起動し、ファイル を開いた後、ファイルを閉じる処理でエラーとなります。 エラー時の処理は作っていません。
「サンプル.xls」というファイルを開く様にしています。 このファイルを、Excelで既に、開いている状態で、動かすと、 ファイルを閉じる処理で、エラーとなります。
ファイルを閉じる処理は、 xlBook.SaveAs strExcelFile xlBook.Close xlApp.Quit を行っていますが、 xlBook.SaveAs strExcelFile でエラーとなってしまいます。 どのよにすれば、正常に終了できますか。
もう1点、教えて欲しいのですが、 ファイルを開く際に、該当のファイルが、既に開かれているか確認して、 開かれている場合、メッセージを出して終了、開かれていない場合、処理を継続 したいのですが、どのようにすればよいですか。
お願いします。
-------------------------------------------------------------------------------- Private Sub Command1_Click() Dim Fso As FileSystemObject Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Dim ws As Excel.Worksheet
Dim FileDir As String Dim strToday As String Dim strExcelFile As String Dim strExcelSheet As String Dim tmpSheet As String Dim wsCnt As Integer
FileDir = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") Set Fso = CreateObject("Scripting.FileSystemObject") If Fso.FolderExists(FileDir) = False Then Fso.CreateFolder FileDir End If
strExcelFile = FileDir & "\" & "サンプル.xls" strExcelSheet = "サンプル"
Set xlApp = New Excel.Application xlApp.SheetsInNewWorkbook = 1 If Fso.FileExists(strExcelFile) = True Then Set xlBook = xlApp.Workbooks.Open(strExcelFile) Set xlSheet = xlBook.Worksheets.Add(after:=xlBook.Worksheets(xlBook.Worksheets.Count)) Else Set xlBook = xlApp.Workbooks.Add Set xlSheet = xlBook.Worksheets(1) End If
wsCnt = 0 For Each ws In xlBook.Worksheets tmpSheet = ws.Name If InStr(1, tmpSheet, strExcelSheet, 1) <> 0 Then wsCnt = wsCnt + 1 End If Next If wsCnt <> 0 Then strExcelSheet = strExcelSheet & " (" & wsCnt + 1 & ")" End If
xlApp.Visible = False xlSheet.Activate
DoEvents
'処理
xlApp.DisplayAlerts = False xlSheet.Name = strExcelSheet xlBook.SaveAs strExcelFile xlBook.Close xlApp.Quit
If Fso.FileExists(strExcelFile) = False Then MsgBox strExcelFile & Chr(13) & Chr(10) & "が作成できません。" Else MsgBox strExcelFile & Chr(13) & Chr(10) & "に作成しました。" End If
Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing Set Fso = Nothing End Sub
|