VB excel 打开无法关闭

  最近做了一个数据库工具,数据库数据导出成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, ";pwd=hehui@famidoc")  '打开数据库
    '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

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值