如何关闭vb6中的所有活动.xls文件

时间:2011-09-19 09:12:37

标签: excel vb6

我尝试过类似的东西:

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

2 个答案:

答案 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
  • 你的完整kitmap代码是什么,即你打开和关闭了工作簿吗?
  • 你有没有打开任何其他xl实例(代码之前或期间)?

this link经常解决VBA问题,修复全局参考

请注意,最好关闭/退出工作簿/实例并将其设置为Nothing,即在Tushar的代码中

 xlWB.Close False
 xlApp.Quit
 Set xlWB = Nothing
 Set xlApp = Nothing