Как закрыть все активные.файлы xls в vb6


Я пробовал нечто подобное:

Set kitap = CreateObject("Excel.Application")
If IsXlsOpen() = True Then
    kitap.Application.Quit
End If

.. но ничего не вышло, поэтому мне нужно было найти, как закрыть все файлы excel перед запуском моей программы в vb6

редактировать: полный код здесь:

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 2

2 ответа:

Хотя я больше vbscript и VBA парень, немного больше информации поможет:

  • т. е. Что такое IsXlsOpen?
  • каков ваш полный код kitmap, то есть вы открывали и закрывали книги?
  • Есть ли у вас другие открытые экземпляры xl (до или во время вашего кода)?.

Эта ссылка часто решает проблемы VBA, фиксируя глобальные ссылки

Обратите внимание, что хорошей практикой является закрытие/выход из книг / экземпляров и установка их в Nothing, т. е. в коде Тушара
 xlWB.Close False
 xlApp.Quit
 Set xlWB = Nothing
 Set xlApp = Nothing

Чтобы сохранить и закрыть все книги, подробнее

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