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