tagCANDY CGI VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板
VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板
[ツリー表示へ]  [ワード検索]  [Home]

タイトル VBからExcel起動でファイルを開く
投稿日: 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

- 関連一覧ツリー をクリックするとツリー全体を一括表示します)

古いスレッドにレスはつけられません。