locked
Other open excel files breaks VB.Net Application RRS feed

  • Question

  • My VB.Net application opens an excel file read and writes then saves. The issue is when there is a different excel file already open or being opened the application crash because I believe it trying to read from that new opened or already open excel file.

    Is there any way to force the application to only read from the excel file that it opens and to ignore excel files that user has already opened or is going to open.

    I am using the Imports Excel = Microsoft.Office.Interop.Excel way of accessing a excel file.

    Here is a link to example that another person that basically same as mine https://social.msdn.microsoft.com/Forums/office/en-US/4a9d45db-e96c-40e9-af4b-b683ba76dfdc/cannot-open-another-excel-file-while-c-is-working-on-excel-objects?forum=excelde

    Here is the Code:

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    
    
        Dim App As New Excel.Application
        Dim workBook As Excel.Workbook
        Dim workSheet As Excel.Worksheet
        Dim sqlConnection As New SqlConnection
        Dim sqlDataReader As SqlDataReader
        Dim query As New SqlCommand
        'Dim result As New DataSet
        Dim emptyCellCount, rowIndex, rowCount, SMNotCompleteCounter, HeaderNotCompleteCounter, TubeNotCompleteCounter, FinNotCompleteCounter As Integer
        Dim SMExists, HeaderExists, TubeExists, FinExists As Boolean
        Dim loadingString As String = "Loading"
        Dim startTime, endTime As Date
        Dim elaspedTime As TimeSpan
        Dim elaspedTimeArray As New List(Of Integer)
        '**********************************************************
        'Open Excel Doc To Query
        Dim openFileDialogBox As New OpenFileDialog
    
        openFileDialogBox.Filter = "Excel Sheet (*.xlsx, *.xlsm)|*.xlsx;*.xlsm"
        If openFileDialogBox.ShowDialog = DialogResult.OK Then
            If openFileDialogBox.FileName.Contains(".xlsx") Or openFileDialogBox.FileName.Contains(".xlsm") Then
                Label1.Visible = True
                Label1.Text = "Verifing"
                App.DisplayAlerts = False
                workBook = App.Workbooks.Open(openFileDialogBox.FileName)
                workSheet = workBook.Worksheets(1)
    
                If workSheet.Name = "MASTER" Then
    
                    Label1.Text = loadingString
                    'workBook.Unprotect()
                    '**********************************************************
    
                    'workBook = App.Workbooks.Open("\\srv-ts-01\Shared\Cancoil Production schedule\Production Schedule\Cancoils Production Schedule by Week.xlsm")
    
    
                    'workSheet.PrintOut(1, 1, 1)
                    rowCount = 0
                    emptyCellCount = 0
                    rowIndex = 2
                    SMNotCompleteCounter = 0
                    HeaderNotCompleteCounter = 0
                    TubeNotCompleteCounter = 0
                    FinNotCompleteCounter = 0
                    SMExists = False
                    HeaderExists = False
                    TubeExists = False
                    FinExists = False
                    'workBook.SaveCopyAs("C: \Users\devin-l\Desktop\Test5.xlsm")
    
                    sqlConnection.ConnectionString = "Data Source=stuff;Initial Catalog=CTC_App;Integrated Security=False;User ID=stuff;Password=stuff;Connect Timeout=15;Encrypt=False;TrustServerCertificate=False;ApplicationIntent=ReadWrite;MultiSubnetFailover=False"
                    sqlConnection.Open()
    
                    'LoadingGif.Visible = True
                    'Button1.Visible = False
    
                    While emptyCellCount < 50 'And rowIndex < 50
                        If IsNothing(workSheet.Cells(rowIndex, 1).value) = False Or IsNothing(workSheet.Cells(rowIndex, 2).value) = False Or IsNothing(workSheet.Cells(rowIndex, 3).value) = False Then
                            rowCount += 1
                            rowIndex += 1
                            emptyCellCount = 0
                        Else
                            emptyCellCount += 1
                        End If
    
                    End While
    
                    emptyCellCount = 0
                    rowIndex = 2
    
                    While emptyCellCount < 5 'And rowIndex < 50
                        startTime = DateAndTime.Now
    
                        If Label1.Text >= "Loading......" Then
                            Label1.Text = loadingString
                        Else
                            Label1.Text = Label1.Text & "."
                        End If
    
                        If IsNothing(workSheet.Cells(rowIndex, 1).value) = False Or IsNothing(workSheet.Cells(rowIndex, 2).value) = False Or IsNothing(workSheet.Cells(rowIndex, 3).value) = False Then
                            If IsNothing(workSheet.Cells(rowIndex, 3).value) = False Then
                                If IsNumeric(workSheet.Cells(rowIndex, 3).value) = True Then
    
                                    query.CommandText = "some query"
    
                                    query.Connection = sqlConnection
                                    sqlDataReader = query.ExecuteReader()
    
                                    If sqlDataReader.HasRows Then
                                        While sqlDataReader.Read
    
                                            If (sqlDataReader.Item(1) = "SM" Or sqlDataReader.Item(1) = "SQSHR" Or sqlDataReader.Item(1) = "LNSHR") Then
                                                SMExists = True
                                                If sqlDataReader.Item(2) <> "C" Then
                                                    SMNotCompleteCounter += 1
                                                End If
    
                                            ElseIf (sqlDataReader.Item(1) = "B20805" Or sqlDataReader.Item(1) = "B30806" Or sqlDataReader.Item(1) = "B30807" Or
                                            sqlDataReader.Item(1) = "B41008" Or sqlDataReader.Item(1) = "B41211" Or sqlDataReader.Item(1) = "B51211" Or
                                            sqlDataReader.Item(1) = "B308FA" Or sqlDataReader.Item(1) = "CMS001" Or sqlDataReader.Item(1) = "CMS002") Then
                                                TubeExists = True
                                                If sqlDataReader.Item(2) <> "C" Then
                                                    TubeNotCompleteCounter += 1
                                                End If
    
                                            ElseIf (sqlDataReader.Item(1) = "CRIPPA" Or sqlDataReader.Item(1) = "HDBRZ" Or sqlDataReader.Item(1) = "HDRBRZ" Or
                                            sqlDataReader.Item(1) = "OAK LD" Or sqlDataReader.Item(1) = "TDRILL" Or sqlDataReader.Item(1) = "CUT3" Or
                                            sqlDataReader.Item(1) = "CUT4" Or sqlDataReader.Item(1) = "CUT5" Or sqlDataReader.Item(1) = "CRSBND" Or
                                            sqlDataReader.Item(1) = "TUBE" Or sqlDataReader.Item(1) = "OAK001" Or sqlDataReader.Item(1) = "PIPCUT" Or
                                            sqlDataReader.Item(1) = "PIPTHD" Or sqlDataReader.Item(1) = "CMS1/2" Or sqlDataReader.Item(1) = "CMS1/4" Or
                                            sqlDataReader.Item(1) = "CMS187" Or sqlDataReader.Item(1) = "CMS3/4" Or sqlDataReader.Item(1) = "CMS3/8" Or
                                            sqlDataReader.Item(1) = "CMS5/8" Or sqlDataReader.Item(1) = "CMS7/8" Or sqlDataReader.Item(1) = "CMSHDR" Or
                                            sqlDataReader.Item(1) = "HDRPCH" Or sqlDataReader.Item(1) = "HDRPUN" Or sqlDataReader.Item(1) = "RED1" Or
                                            sqlDataReader.Item(1) = "TDRCON" Or sqlDataReader.Item(1) = "HDBRAZ") Then
                                                HeaderExists = True
                                                If sqlDataReader.Item(2) <> "C" Then
                                                    HeaderNotCompleteCounter += 1
                                                End If
    
                                            ElseIf (sqlDataReader.Item(1) = "20805C" Or sqlDataReader.Item(1) = "20805F" Or sqlDataReader.Item(1) = "31008" Or
                                            sqlDataReader.Item(1) = "30806C" Or sqlDataReader.Item(1) = "30806F" Or sqlDataReader.Item(1) = "30807C" Or
                                            sqlDataReader.Item(1) = "F30807" Or sqlDataReader.Item(1) = "41008C" Or sqlDataReader.Item(1) = "F41008" Or
                                            sqlDataReader.Item(1) = "41211C" Or sqlDataReader.Item(1) = "F41211" Or sqlDataReader.Item(1) = "51211C" Or
                                            sqlDataReader.Item(1) = "51211F" Or sqlDataReader.Item(1) = "C386C" Or sqlDataReader.Item(1) = "C386L" Or
                                            sqlDataReader.Item(1) = "41008F" Or sqlDataReader.Item(1) = "41211F") Then
                                                FinExists = True
                                                If sqlDataReader.Item(2) <> "C" Then
                                                    FinNotCompleteCounter += 1
                                                End If
    
                                            End If
                                        End While
    
                                        If SMNotCompleteCounter = 0 And SMExists = True Then
                                            workSheet.Cells(rowIndex, 18).value = "X"
                                        Else
                                            SMNotCompleteCounter = 0
                                        End If
    
                                        If TubeNotCompleteCounter = 0 And TubeExists = True Then
                                            workSheet.Cells(rowIndex, 19).value = "X"
                                        Else
                                            TubeNotCompleteCounter = 0
                                        End If
    
                                        If HeaderNotCompleteCounter = 0 And HeaderExists = True Then
                                            workSheet.Cells(rowIndex, 24).value = "X"
                                        Else
                                            HeaderNotCompleteCounter = 0
                                        End If
    
                                        If FinNotCompleteCounter = 0 And FinExists = True Then
                                            workSheet.Cells(rowIndex, 27).value = "X"
                                        Else
                                            FinNotCompleteCounter = 0
                                        End If
                                    Else
                                        workSheet.Cells(rowIndex, 13).value = "Not In Database"
                                        sqlDataReader.Close()
                                    End If
    
                                    sqlDataReader.Close()
                                    rowIndex += 1
                                    emptyCellCount = 0
                                    SMExists = False
                                    HeaderExists = False
                                    TubeExists = False
                                    FinExists = False
                                Else
                                    rowIndex += 1
                                    emptyCellCount = 0
                                End If
                            Else
                                rowIndex += 1
                                emptyCellCount = 0
                            End If
                        Else
                            emptyCellCount += 1
    
                        End If
                        endTime = DateAndTime.Now
                        elaspedTime = endTime - startTime
                        elaspedTimeArray.Add(elaspedTime.Milliseconds)
    
    
                        If (elaspedTimeArray.Count >= 20) Then
                            Dim timeRemaining As Double
                            timeRemaining = (elaspedTimeArray.Average * (rowCount - (rowIndex - 2)))
                            If timeRemaining <= 60000.0# Then
                                Label2.Text = "Time Remaining: " & Math.Floor(timeRemaining / 1000).ToString & " Secs"
                            Else
                                Label2.Text = "Time Remaining: " & Math.Ceiling(timeRemaining / 60000).ToString & " Mins"
                            End If
    
                            Label2.Visible = True
                        End If
    
                    End While
                    Label2.Visible = False
                    'MsgBox(
                    '    "Actual Total Process Time: " & Math.Round(((elaspedTimeArray.Sum) / 1000)).ToString & "Secs" & vbNewLine &
                    '    "Average Total Process Time: " & Math.Round(((elaspedTimeArray.Average * rowCount) / 1000)).ToString & "Secs"
                    '    )
                    'SqlDataAdapter.Dispose()        query.Dispose()
                    'result.Dispose()
                    sqlConnection.Close()
    
                    'workSheet.Range("C4").Value = "Alpha"
    
                    'workBook.Saved = True
                    'workBook.Save()
                    '**********************************************************
                    'Save As Mode Code
                    Dim saveAsDialogBox As New SaveFileDialog
                    workSheet.Columns.AutoFit()
                    saveAsDialogBox.DefaultExt = My.Computer.FileSystem.GetFileInfo(openFileDialogBox.FileName).Extension.ToString
                    'saveAsDialogBox.Filter = "Excel File (*.xlsx*)|*.xlsx|Excel File (*.xlsm*)|*.xlsm"
                    While True
                        If saveAsDialogBox.ShowDialog = DialogResult.OK Then
                            If saveAsDialogBox.FileName.Contains(saveAsDialogBox.DefaultExt) Then
                                Label1.Text = "Saving"
                                workBook.SaveAs(saveAsDialogBox.FileName)
                                workBook.Close()
                                Exit While
                            Else
                                MsgBox("No Dot File Extensions Accepted (.pdf,.txt,.xlsx, Etc.) ")
                                saveAsDialogBox.FileName = Nothing
                            End If
                        Else
                            If MsgBox("Do You Want To Save", MsgBoxStyle.YesNo) = MsgBoxResult.No Then
                                workBook.Close(False)
                                Exit While
                            End If
                        End If
                    End While
                    '**********************************************************
    
    
                    App.Quit()
                    Label1.Visible = False
                    System.Runtime.InteropServices.Marshal.FinalReleaseComObject(workSheet)
                    System.Runtime.InteropServices.Marshal.FinalReleaseComObject(workBook)
                    System.Runtime.InteropServices.Marshal.FinalReleaseComObject(App)
                    GC.Collect()
                    'LoadingGif.Visible = False
                    'Button1.Visible = True
                    MsgBox("Update And Save Complete !!!!! ")
                    'Open Excel Doc To view
                    'System.Diagnostics.Process.Start("C:\Users\devin-l\Desktop\Test2.xlsx")
                Else
                    workBook.Close(False)
                    App.Quit()
                    System.Runtime.InteropServices.Marshal.FinalReleaseComObject(workSheet)
                    System.Runtime.InteropServices.Marshal.FinalReleaseComObject(workBook)
                    System.Runtime.InteropServices.Marshal.FinalReleaseComObject(App)
                    GC.Collect()
                    MsgBox("MASTER Excel Sheet Missing Or Wrong Excel Document Selected")
                End If
            Else
                MsgBox("Please Select A Excel Document")
            End If
        End If
    End Sub

    Monday, April 25, 2016 6:19 PM

Answers

  • I don't know either and that was the same conclusion I came to but I discover a solution that seems to work.

    excel app object property called IgnoreRemoteRequests setting to true make excel.open create a new instance of excel everytime which solves my problem


    https://msdn.microsoft.com/en-us/library/office/ff836184.aspx
    Monday, April 25, 2016 8:04 PM

All replies

  • Microsoft Excel has limited multi-threading capability and I know that VBA code automation is not supported in this respect. Since only one instance of Excel is opened I would suspect that is where you are encountering the issue. Can you control this? Not that I am aware of.

    Paul ~~~~ Microsoft MVP (Visual Basic)

    Monday, April 25, 2016 7:41 PM
  • I don't know either and that was the same conclusion I came to but I discover a solution that seems to work.

    excel app object property called IgnoreRemoteRequests setting to true make excel.open create a new instance of excel everytime which solves my problem


    https://msdn.microsoft.com/en-us/library/office/ff836184.aspx
    Monday, April 25, 2016 8:04 PM