Keskustelu: Ohjelmointikysymykset: VB6 & Excel yhteys (VBA)

Option Explicit

Private xlDataApp As Excel.Application
Private xlDataBook As Excel.Workbook
Private ExcelWasNotRunning As Boolean

Private Sub Command1_Click()
    If Not funcOpenExcel Then
        MsgBox "ErrorTerror"
    Else
        xlDataBook.Application.Range("B2").Value = "Hello World!"
        MsgBox xlDataBook.Application.Range("B2").Value
        If ExcelWasNotRunning Then If Not xlDataBook.Application.Visible Then xlDataApp.Visible = True
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)

On Error Resume Next

    xlDataBook.Saved = True                     'Kun ei haluta tallentaa muutoksia, pitää valehdella
    xlDataBook.Close                            'Suljetaan käytetty Workbook
    If ExcelWasNotRunning = True Then           'Tarkistetaan oliko Excel käynnissä
        xlDataApp.Application.Quit              'Jos ei niin suljetaan se...
    Else
        xlDataApp.Application.Visible = True    'Muussa tapauksessa aktivoidaan se
    End If

    If Err.Number <> 0 Then Err.Clear
    Set xlDataBook = Nothing                    'Vapautetaan käytetyt xl-muuttujat
    Set xlDataApp = Nothing
    End

End Sub

Private Function funcOpenExcel(Optional file As String) As Boolean
    Dim MyXl As Object

On Error Resume Next

    funcOpenExcel = False
    ExcelWasNotRunning = False

    Set MyXl = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then ExcelWasNotRunning = True   '0:lla Excel käynnissä, muuten virhe
    Err.Clear                                           'Putsataan Virhe-koodi

    Set xlDataApp = IIf(ExcelWasNotRunning, New Excel.Application, MyXl)

    Set xlDataBook = funcOpenWorkbook(file)
    If Err.Number = 0 Then funcOpenExcel = True
    Err.Clear
    Set MyXl = Nothing

End Function

Private Function FetchFile(ByVal file As String) As String
    FetchFile = Right(file, Len(file) - InStrRev(file, "\"))
End Function

Private Function funcOpenWorkbook(ByVal file As String) As Excel.Workbook
    Dim xlBook As Excel.Workbook
    Dim FileWasNotOpen As Boolean
    Dim FileName As String
    Dim i As Integer

    If file <> "" Then
        If InStr(1, file, "\") = 0 Then
            FileName = file
            file = App.Path & "\" & file
        Else
            FileName = FetchFile(file)
        End If
        If xlDataApp.Application.Workbooks.Count <> 0 Then
            For i = 1 To xlDataApp.Workbooks.Count
                If xlDataApp.Workbooks(i).name = FileName Then
                    Set xlBook = xlDataApp.Workbooks(i) 'File on auki ja se otetaan käyttöön
                    xlBook.Saved = True                 'Tiedosto suljetaan ilman talletusta, joten .Saved=true
                    xlBook.Close                        'Suljetaan avonainen tiedosto...
                    FileWasNotOpen = True               '...näin varmistetaan halutun laisen tiedoston avaaminen
                    Exit For                            'avaamalla sen uudestaan
                End If
                FileWasNotOpen = True               'tiedostoja on auki, mutta File ei ole auki
            Next
        Else
            FileWasNotOpen = True                   'Tiedostoja ei ole auki, joten File ei ole auki
        End If

        If FileWasNotOpen Then
            Set xlBook = xlDataApp.Workbooks.Open(file)
            FileWasNotOpen = False
            For i = 1 To xlDataApp.Workbooks.Count
                If xlDataApp.Workbooks(i).name = FileName Then
                    Exit For
                End If
            Next
        End If

        xlBook.Application.Workbooks(i).Activate    'Aktivoidaan avattu tiedosto
    Else
        Set xlBook = xlDataApp.Application.Workbooks.Add
    End If

    Set funcOpenWorkbook = xlBook
    Set xlBook = Nothing

End Function