最近做了一個數據庫工具，資料庫資料匯出成excel後自動開啟excel檔案，但發現第二次開啟同一個檔案時（開啟前用VB關閉了的），無法正常執行。網上也是很多人碰到此問題，無法解決。後來我不用VB關閉excel，而是模擬操作手動關閉excel。這樣就完全可以了。程式碼如下：

Private Declare Function FindWindow% Lib "user32" Alias "FindWindowA" (ByVal lpclassname As Any, ByVal lpCaption As Any)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const NILL = 0&
Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) _
As Long

Function closeExcel()‘系統資訊，關閉excel。
Dim hwnd%
Dim x As Integer
hwnd% = FindWindow%("XLMAIN", 0&)
x = SendMessage(hwnd%, WM_SYSCOMMAND, SC_CLOSE, NILL)
End Function

'filename為excel的檔名，不包路徑。sqlS是從mdb導到excel的語句。
Function fnExcelOutAndShow(filename As String, sqlS As String) As Boolean
On Error Resume Next

Dim ret As Integer
Dim objDB As Database   '資料庫

Dim xlApp As Excel.Application  'excel的應用程式
Dim xlBook As Excel.Workbook    'excel的工作視窗
Dim xlsheet As Excel.Worksheet  'excel的sheet
fnExcelOutAndShow = False
    '-----------------------------------------------------------------------------------------判斷excel文並刪除，如果佔用則提示關閉。
    If Dir(App.Path & "/報表/" & filename) <> "" Then
        Err.Clear
        Kill App.Path & "/報表/" & filename
        If Err.Number > 0 Then
            ret = MsgBox("檔案被開啟，是否自動關閉所有excel繼續匯出報表？", vbYesNo)
            If ret = vbNo Then GoTo endfnExcelOutAndShow
            Call closeExcel
            Kill App.Path & "/報表/" & filename
        End If
    End If
    '------------------------------------------------------------------------------------------由mdb導到excel檔案中
    Set objDB = OpenDatabase(App.Path & "\Famidoc.mdb", False, False, ";

[email protected]")  '開啟資料庫
    'If excel file already exists, you can delete it here
    If Dir(App.Path & "/報表/" & filename) <> "" Then Kill App.Path & "/報表/" & filename
    objDB.Execute sqlS
    objDB.Close
    Set objDB = Nothing
    '------------------------------------------------------------------------------------------開啟excel文並修改格式
    ret = MsgBox("是否自動開啟檔案：" & filename, vbYesNo)
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open(App.Path & "\報表\" & filename)
    Set xlsheet = xlBook.Worksheets(1)
    If ret = vbYes Then
        xlApp.Visible = True
    Else
        xlApp.Visible = False
    End If
    xlsheet.Rows.HorizontalAlignment = xlLeft       '文字全部左對齊
    xlApp.ActiveSheet.Columns.EntireColumn.AutoFit  '自動調整寬度
    xlBook.Save                                     '存檔
    If ret = vbYes Then
        Set xlApp = Nothing
    Else
        xlBook.Close True
        xlApp.Quit
        Set xlApp = Nothing
        ShellExecute frmMain.hwnd, vbNullString, App.Path & "\報表", vbNullString, vbNullString, 1 '不開啟檔案則顯示資料夾
    End If
    Set xlBook = Nothing
    Set xlsheet = Nothing
    fnExcelOutAndShow = True

endfnExcelOutAndShow:
End Function

'ShellExecute frmMain.hwnd, vbNullString, App.Path & "/報表", vbNullString, vbNullString, 1
Function OpenWordFileder()

End Function