Error in Exporting to exel in VB.Net

Question

0.00/5 (No votes)

See more:

Hi Everyone

I have written a application the exports data from database to excel. It worked properly . But if i open some other Excel file and place the mouse pointer inside the cell and do a export,It showed error

Creating an instance of the COM component with CLSID {00020820-0000-0000-C000-000000000046} from the IClassFactory failed due to the following error: 8001010a

Kindly suggest me what to do.

code

VB

Try
   excelSheet = New Excel.Worksheet
Catch ex As Exception
   MsgBox("Error opening excel Sheet")
End Try

Thanks

Posted 21-Feb-13 18:50pm

Geo Jackson

Updated 22-Feb-13 3:11am

Abhishek Pant

v2

Add a Solution

Comments

Abhishek Pant 22-Feb-13 1:02am

http://forums.asp.net/t/1297762.aspx/1[^]

Geo Jackson 22-Feb-13 1:04am

Sorry I forgot to mention it, my application is Windows Application.

3 solutions

Solution 3

try this sniffet..

VB

<pre>
    Private Sub ExportData()
        If b_Work Then Exit Sub
        cmdExport.Text = "&Cancel"
        b_Work = True
        Me.Cursor = Cursors.WaitCursor

        Dim oldCI As System.Globalization.CultureInfo = System.Threading.Thread.CurrentThread.CurrentCulture
        System.Threading.Thread.CurrentThread.CurrentCulture = New System.Globalization.CultureInfo("en-US")

        Dim oXL As Excel.Application = Nothing
        Dim oWBs As Excel.Workbooks = Nothing
        Dim oWB As Excel.Workbook = Nothing
        Dim oSheet As Excel.Worksheet = Nothing

        oXL = New Excel.Application
        oXL.Visible = False
        oXL.UserControl = False
        oXL.ScreenUpdating = False
        oXL.DisplayAlerts = False

        oWBs = oXL.Workbooks

        Dim sKriteria As String = ""

        If m_KdLokasi.Length < 8 Then
            sKriteria = " WHERE ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC]) LIKE '" & m_KdLokasi & "%' "
        Else
            sKriteria = " WHERE ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC])='" & m_KdLokasi.Substring(0, 8) & "' "
        End If

        Dim sNamaKec As ArrayList = GetQryField(" SELECT ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC]) AS [KD_LOKASI], [KECAMATAN],[KD_KEC]" & _
                                                " FROM [TB_KEC] " & sKriteria & " ORDER BY [KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC];")

        For iKec As Integer = 0 To sNamaKec.Count - 1
            If b_Cancel Then GoTo ErrCanceling

            Dim MyArrKec() As String = sNamaKec(iKec)

            Dim NamaFolder As String = m_Folder & "\"

            If m_KdLokasi.Length < 10 Then
                NamaFolder = m_Folder & "\" & MyArrKec(2).ToString & "-" & MyArrKec(1).ToString & "\"
            End If

            NamaFolder = Replace(NamaFolder, "\\", "\")

            If Not System.IO.Directory.Exists(NamaFolder) Then
                System.IO.Directory.CreateDirectory(NamaFolder)
            End If

            sKriteria = ""
            If m_KdLokasi.Length < 10 Then
                sKriteria = " WHERE ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC])='" & MyArrKec(0).ToString & "' "
            Else
                sKriteria = " WHERE ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC]+[KD_KEL])='" & m_KdLokasi.Substring(0, 10) & "' "
            End If

            Dim sNamaKel As ArrayList = GetQryField( _
                    " SELECT ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC]+[KD_KEL]) AS [KD_LOKASI], [KELURAHAN],[KD_KEL] " & _
                    " FROM [TB_KEL] " & sKriteria & _
                    " ORDER BY ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC]+[KD_KEL]);")


            For iKel As Integer = 0 To sNamaKel.Count - 1
                Dim MyArrKel = sNamaKel(iKel)
                Application.DoEvents()
                If b_Cancel Then GoTo ErrCanceling

                oXL.UserControl = False
                oWB = oWBs.Open(MyPath() & "\PRINTOUT.XLT")
                Dim NamaFile As String = MyArrKel(2) & "-" & MyArrKel(1)
                If Not System.IO.File.Exists(NamaFolder & NamaFile & ".xlsx") Then
                    oWB.SaveAs(NamaFolder & NamaFile & ".xlsx")
                Else
                    oWB.SaveAs(NamaFolder & NamaFile & "_" & TimeValue(Now).ToString("hhmmss") & ".xlsx")
                End If

                sKriteria = ""
                If m_KdLokasi.Length < 12 Then
                    sKriteria = " WHERE ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC]+[KD_KEL])='" & MyArrKel(0).ToString & "' "
                Else
                    sKriteria = " WHERE ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC]+[KD_KEL]+[KD_TPS])='" & m_KdLokasi.Substring(0, 12) & "' "
                End If

                Dim sNamaTPS As ArrayList = GetQryField( _
                        " SELECT ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC]+[KD_KEL]+[KD_TPS]) AS [KD_LOKASI], [NAMA_TPS] ,[KD_TPS]" & _
                        " FROM [TB_TPS] " & sKriteria & _
                        " ORDER BY ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC]+[KD_KEL]+[KD_TPS]);")

                If m_KdLokasi.Length = 12 Then
                    For Each oSheet In oWB.Sheets
                        If (CInt(Val(Mid(oSheet.Name, 5, 2))) <> CInt(m_KdLokasi.Substring(11, 2))) Then
                            oSheet.Delete()
                        End If
                    Next
                Else
                    For Each oSheet In oWB.Sheets
                        If (CInt(Val(Mid(oSheet.Name, 5, 2))) < 1) Or (CInt(Val(Mid(oSheet.Name, 5, 2))) > CInt(sNamaTPS.Count)) Then
                            If oSheet.Name <> "RKP_TPS" Then
                                oSheet.Delete()
                            End If
                        End If
                    Next
                    oSheet = oWB.Sheets("RKP_TPS")
                    oSheet.Activate()
                    oSheet.Range(oSheet.Cells(14 + CInt(sNamaTPS.Count), 1), oSheet.Cells(44, 6)).Value = ""
                    oSheet.Range(oSheet.Cells(14 + CInt(sNamaTPS.Count), 1), oSheet.Cells(44, 6)).Delete(Excel.XlDeleteShiftDirection.xlShiftUp)
                End If

                For iTps As Integer = 0 To sNamaTPS.Count - 1
                    Dim MyArrTPS = sNamaTPS(iTps)
                    Application.DoEvents()
                    If b_Cancel Then GoTo ErrCanceling

                    oSheet = oWB.Sheets("TPS-" & CInt(MyArrTPS(2)).ToString("00"))

                    oSheet.Activate()

                    oSheet.Cells(4, 3) = MyArrTPS(1) & "  (" & Mid(MyArrTPS(0).ToString, MyArrTPS(0).ToString.Length - 1) & ")"    ' Nama TPS
                    oSheet.Cells(5, 3) = MyArrKel(1) & "  (" & Mid(MyArrKel(0).ToString, MyArrKel(0).ToString.Length - 1) & ")"   ' Nama Kelurahan
                    oSheet.Cells(6, 3) = MyArrKec(1) & "  (" & Mid(MyArrKec(0).ToString, MyArrKec(0).ToString.Length - 1) & ")"
                    oSheet.Cells(4, 10) = "DAPIL-" & MyArrKec(0).Substring(4, 2) & "  (" & MyArrKec(0).Substring(4, 2) & ")"

                    Using oCnDPT As SqlConnection = New SqlConnection(SQL_CONNECTION_STRING)
                        Using oCmd_DPT As SqlCommand = New SqlCommand( _
                            " SELECT * FROM [TB_PEMILIH] WHERE [KD_LOKASI]='" & MyArrTPS(0).ToString & "' " & _
                            " ORDER BY [KD_LOKASI],[NO_URUT];", oCnDPT)

                            oCnDPT.Open()
                            Dim rdr_DPT As SqlDataReader = oCmd_DPT.ExecuteReader
                            Dim rw As Integer = 0
                            Dim LastRow As Integer = 0
                            Dim NoUrut As Integer = 0


                            Do While rdr_DPT.Read()
                                Application.DoEvents()
                                wlProgress.Text = MyArrKel(1) & "\" & MyArrTPS(1) & vbCrLf & rdr_DPT.GetValue(1) & "-" & rdr_DPT.GetValue(4)
                                With oSheet
                                    NoUrut = NoUrut + 1

                                    'If NoUrut > 50 And (NoUrut Mod 25) = 1 Then rw = rw + 3

                                    If NoUrut > 1 Then
                                        '.Range(.Cells(12 + LastRow, 1), .Cells(12 + LastRow, 11)).Copy(.Cells(12 + rw, 1))
                                        .Range(.Cells(12 + rw, 1), .Cells(12 + rw, 10)).Value = ""
                                    End If

                                    Dim sTmpNIK As String = Mid(rdr_DPT.GetValue(0), 1, 4) & Mid(rdr_DPT.GetValue(0), 7, 2)
                                    Dim sTmpTgl As String = "0101001031"
                                    Dim sNik As String = rdr_DPT.GetValue(2) & ""
                                    sNik = Replace(sNik, " ", "")
                                    sNik = Trim(Replace(sNik, "+", ""))

                                    If IsDate(rdr_DPT.GetValue(5)) Then
                                        sTmpTgl = Format(CDate(rdr_DPT.GetValue(5)), "ddMMyy") & "100"
                                        If UCase(Trim(rdr_DPT.GetValue(8))) = "L" Then
                                            sTmpTgl = sTmpTgl & "1"
                                        Else
                                            sTmpTgl = sTmpTgl & "2"
                                        End If
                                    End If


                                    .Cells(12 + rw, 1) = NoUrut 'CDbl("0" & rdr_DPT.GetValue(1))  'NoUrut

                                    If Len(sNik) < 16 Then
                                        sTmpNIK = "'" & sTmpNIK & sTmpTgl
                                    Else
                                        sTmpNIK = "'" & sNik
                                    End If

                                    .Cells(12 + rw, 2) = sTmpNIK


                                    .Cells(12 + rw, 3) = rdr_DPT.GetValue(3)
                                    .Cells(12 + rw, 4) = rdr_DPT.GetValue(4) & ", " & rdr_DPT.GetDateTime(5).ToString("dd-MM-yyyy")

                                    If Year(rdr_DPT.GetDateTime(5)) = 1900 Then
                                        .Cells(12 + rw, 5) = "?"
                                    Else
                                        .Cells(12 + rw, 5) = rdr_DPT.GetValue(6)
                                    End If

                                    .Cells(12 + rw, 6) = UCase(Trim(rdr_DPT.GetValue(7)))

                                    If UCase(Trim(rdr_DPT.GetValue(8))) = "L" Then
                                        .Cells(12 + rw, 7) = "L"
                                    Else
                                        .Cells(12 + rw, 8) = "P"
                                    End If

                                    .Cells(12 + rw, 9) = rdr_DPT.GetValue(9)
                                    .Cells(12 + rw, 10) = rdr_DPT.GetValue(10)        'rdr_DPT(14)

                                    .Range(.Cells(12 + rw, 1), .Cells(12 + rw, 10)).Borders.LineStyle = 1

                                End With

                                LastRow = rw
                                rw = rw + 1
                            Loop

                            rdr_DPT.Close()

                        End Using
                    End Using

                    oWB.Save()

                Next iTps

                oWB.Save()
                oWB.Close()
                Application.DoEvents()
            Next iKel

        Next iKec

        oXL.Visible = True
        oXL.UserControl = True
        oXL.Quit()

        Dim z As Integer = 0
        z = Marshal.FinalReleaseComObject(oSheet)
        oSheet = Nothing
        z = Marshal.FinalReleaseComObject(oWB)
        oWB = Nothing
        z = Marshal.FinalReleaseComObject(oWBs)
        oWBs = Nothing
        z = Marshal.FinalReleaseComObject(oXL)
        oXL = Nothing

ErrCanceling:
        If b_Cancel Then
            MsgBox("Export dibatalkan", MsgBoxStyle.Critical, "Export to Excel")
        End If

        If Not oWB Is Nothing Then
            oWB.Close(False)
            oWB = Nothing
        End If

        If Not oXL Is Nothing Then
            oXL.Quit()
            oXL = Nothing
        End If

        System.Threading.Thread.CurrentThread.CurrentCulture = oldCI
        Me.Cursor = Cursors.Default
        cmdExport.Text = "&Export"

        If b_Cancel Then
            wlProgress.Text = "Export dibatalkan!"
        Else
            wlProgress.Text = "Export Complete!"
        End If
        b_Cancel = False
        b_Work = False
    End Sub

    Private Sub cmdExport_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdExport.Click
        If TxtFolder.Text = "" OrElse txtLokasi.Text = "" Then Exit Sub
        If cmdExport.Text = "&Export" Then
            If b_IsRekap Then
                ExportRekap(KryptonRadioButton2.Checked)
            Else
                If KryptonCheckBox1.Visible And KryptonCheckBox1.Checked Then
                    _ExportData()
                Else
                    ExportData()
                End If
            End If
        Else
            b_Cancel = True
        End If

        GC.Collect()
        GC.WaitForPendingFinalizers()
        GC.Collect()
        GC.WaitForPendingFinalizers()
    End Sub

maybe better...

Posted 22-Feb-13 18:32pm

Just eg

Add a Solution

Add your solution here

Treat my content as plain text, not as HTML

Preview 0

…

Existing Members

Sign in to your account

...or Join us

Download, Vote, Comment, Publish.

Your Email
Password
Forgot your password?

Your Email
This email is in use. Do you need your password?
Optional Password

I have read and agree to the Terms of Service and Privacy Policy
Please subscribe me to the CodeProject newsletters

When answering a question please:

Read the question carefully.
Understand that English isn't everyone's first language so be lenient of bad spelling and grammar.
If a question is poorly phrased then either ask for clarification, ignore it, or edit the question and fix the problem. Insults are not welcome.
Don't tell someone to read the manual. Chances are they have and don't get it. Provide an answer or move on to the next question.

Let's work to help developers, not make them feel stupid.

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Abhinav S · Accepted Answer · 2013-02-21T19:09:00

Solution 1

Check if you have Excel Com interop dlls installed correctly.
Reinstall Microsoft Excel 11 Object Library again - this will be part of the office installation.

Posted 21-Feb-13 19:09pm

Abhinav S

Geo Jackson · Accepted Answer · 2013-02-22T03:29:00

Solution 2

I solved it by myself

i used

VB

Try
  Dim excelSheet as Excel.Worksheet
Catch ex As Exception
   MsgBox("Error opening excel Sheet")
End Try

and continued my process.

Thanks to All

Posted 22-Feb-13 3:29am

Geo Jackson