我尝试过类似的东西:
Set kitap = CreateObject("Excel.Application")
If IsXlsOpen() = True Then
kitap.Application.Quit
End If
..但没有成功,所以我需要在vb6中开始我的程序之前找到如何关闭所有excel文件
编辑:完整代码:
Dim i As Integer
Dim kitap As Object
Dim strcnn As String
Dim cnn As New ADODB.Connection
Dim Cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
Private Sub Form_Load()
strcnn = "myconn"
cnn.Open strcnn
Cmd.ActiveConnection = cnn
End Sub
Public Function dotdate(ByRef elem) As String
Dim day, month, year As String
year = Right(elem, 4)
month = Mid(elem, Len(elem) - 5, 2)
day = Mid(elem, 1, Len(elem) - 6)
If Len(day) = 1 Then
day = "0" & day
End If
dotdate = day & "." & month & "." & year
End Function
Public Function IsXlsOpen(wbName) As String
Dim xl As Excel.Application
IsXlsOpen = False
On Error Resume Next
Set xl = GetObject(, "Excel.Application")
If Err.Number <> 0 Then Exit Function
xl.Workbooks(wbName).Activate
If Err.Number = 0 Then IsXlsOpen= True
End Function
Private Sub Command1_Click()
Dim i As Integer
Dim cek As String
Set kitap = CreateObject("Excel.Application")
If IsXlsOpen("my.xls") = True Then
kitap.Application.Quit
End If
kitap.Workbooks.Add
cek = "Select * From blabla"
rs.Open cek, cnn
If rs.EOF = True Then
Situation.Caption = "Situation : EOF"
Else
kitap.Cells(i + 1, 1).Value = "ID"
kitap.Cells(i + 1, 2).Value = "Caption"
kitap.Cells(i + 1, 3).Value = "Date"
i = i + 1
Do While Not rs.EOF
kitap.Cells(i + 1, 1).Value = rs.Fields("id")
kitap.Cells(i + 1, 2).Value = rs.Fields("capt")
kitap.Cells(i + 1, 3).Value = dotdate(rs.Fields("date"))
rs.MoveNext
i = i + 1
Loop
rs.Close
End If
kitap.ActiveWorkbook.SaveAs (App.Path & "\my.xls")
kitap.Application.Quit
Situation.Caption = "Situation : Excel Formatted Report Ready."
Exit Sub
err:
rs.Close
Situation.Caption = "Critical Error! : Connection error detected. Please reset action."
End Sub
答案 0 :(得分:2)
保存并关闭所有工作簿,read more
Option Explicit
Sub CloseAndSaveOpenWorkbooks()
Dim Wkb As Workbook
With Application
.ScreenUpdating = False
' Loop through the workbooks collection
For Each Wkb In Workbooks
With Wkb
' if the book is read-only
' don't save but close
If Not Wkb.ReadOnly Then
.Save
End If
' We save this workbook, but we don't close it
' because we will quit Excel at the end,
' Closing here leaves the app running, but no books
If .Name <> ThisWorkbook.Name Then
.Close
End If
End With
Next Wkb
.ScreenUpdating = True
.Quit 'Quit Excel
End With
End Sub
答案 1 :(得分:2)
虽然我更喜欢vbscript和vba,但更多信息会有所帮助:
IsXlsOpen
?this link经常解决VBA问题,修复全局参考
请注意,最好关闭/退出工作簿/实例并将其设置为Nothing
,即在Tushar的代码中
xlWB.Close False
xlApp.Quit
Set xlWB = Nothing
Set xlApp = Nothing