Click here to Skip to main content
Rate this: bad
good
Please Sign up or sign in to vote.
See more: Windows Excel VB.NET WinForm , +
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
Try
   excelSheet = New Excel.Worksheet
Catch ex As Exception
   MsgBox("Error opening excel Sheet")
End Try

Thanks
Posted 21-Feb-13 19:50pm
Edited 22-Feb-13 4:11am
v2
Comments
Geo Jackson at 22-Feb-13 1:04am
   
Sorry I forgot to mention it, my application is Windows Application.
Rate this: bad
good
Please Sign up or sign in to vote.

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.
  Permalink  
Rate this: bad
good
Please Sign up or sign in to vote.

Solution 2

I solved it by myself

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

and continued my process.

Thanks to All
  Permalink  
Rate this: bad
good
Please Sign up or sign in to vote.

Solution 3

try this sniffet..
 
<pre>
    Private Sub ExportData()
        If b_Work Then Exit Sub
        cmdExport.Text = "&Cancel"
        b_Work = True
        Me.Cursor = Cursors.WaitCursor
 
<pre>
    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 &lt; 8 Then
        sKriteria = " WHERE ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC]) LIKE '" &amp; m_KdLokasi &amp; "%' "
    Else
        sKriteria = " WHERE ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC])='" &amp; m_KdLokasi.Substring(0, 8) &amp; "' "
    End If
 
    Dim sNamaKec As ArrayList = GetQryField(" SELECT ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC]) AS [KD_LOKASI], [KECAMATAN],[KD_KEC]" &amp; _
                                            " FROM [TB_KEC] " &amp; sKriteria &amp; " 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 &amp; "\"
 
        If m_KdLokasi.Length &lt; 10 Then
            NamaFolder = m_Folder &amp; "\" &amp; MyArrKec(2).ToString &amp; "-" &amp; MyArrKec(1).ToString &amp; "\"
        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 &lt; 10 Then
            sKriteria = " WHERE ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC])='" &amp; MyArrKec(0).ToString &amp; "' "
        Else
            sKriteria = " WHERE ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC]+[KD_KEL])='" &amp; m_KdLokasi.Substring(0, 10) &amp; "' "
        End If
 
        Dim sNamaKel As ArrayList = GetQryField( _
                " SELECT ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC]+[KD_KEL]) AS [KD_LOKASI], [KELURAHAN],[KD_KEL] " &amp; _
                " FROM [TB_KEL] " &amp; sKriteria &amp; _
                " 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() &amp; "\PRINTOUT.XLT")
            Dim NamaFile As String = MyArrKel(2) &amp; "-" &amp; MyArrKel(1)
            If Not System.IO.File.Exists(NamaFolder &amp; NamaFile &amp; ".xlsx") Then
                oWB.SaveAs(NamaFolder &amp; NamaFile &amp; ".xlsx")
            Else
                oWB.SaveAs(NamaFolder &amp; NamaFile &amp; "_" &amp; TimeValue(Now).ToString("hhmmss") &amp; ".xlsx")
            End If
 
            sKriteria = ""
            If m_KdLokasi.Length &lt; 12 Then
                sKriteria = " WHERE ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC]+[KD_KEL])='" &amp; MyArrKel(0).ToString &amp; "' "
            Else
                sKriteria = " WHERE ([KD_PROP]+[KD_KAB]+[KD_DP]+[KD_KEC]+[KD_KEL]+[KD_TPS])='" &amp; m_KdLokasi.Substring(0, 12) &amp; "' "
            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]" &amp; _
                    " FROM [TB_TPS] " &amp; sKriteria &amp; _
                    " 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))) &lt;&gt; 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))) &lt; 1) Or (CInt(Val(Mid(oSheet.Name, 5, 2))) &gt; CInt(sNamaTPS.Count)) Then
                        If oSheet.Name &lt;&gt; "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-" &amp; CInt(MyArrTPS(2)).ToString("00"))
 
                oSheet.Activate()
 
                oSheet.Cells(4, 3) = MyArrTPS(1) &amp; "  (" &amp; Mid(MyArrTPS(0).ToString, MyArrTPS(0).ToString.Length - 1) &amp; ")"    ' Nama TPS
                oSheet.Cells(5, 3) = MyArrKel(1) &amp; "  (" &amp; Mid(MyArrKel(0).ToString, MyArrKel(0).ToString.Length - 1) &amp; ")"   ' Nama Kelurahan
                oSheet.Cells(6, 3) = MyArrKec(1) &amp; "  (" &amp; Mid(MyArrKec(0).ToString, MyArrKec(0).ToString.Length - 1) &amp; ")"
                oSheet.Cells(4, 10) = "DAPIL-" &amp; MyArrKec(0).Substring(4, 2) &amp; "  (" &amp; MyArrKec(0).Substring(4, 2) &amp; ")"
 
                Using oCnDPT As SqlConnection = New SqlConnection(SQL_CONNECTION_STRING)
                    Using oCmd_DPT As SqlCommand = New SqlCommand( _
                        " SELECT * FROM [TB_PEMILIH] WHERE [KD_LOKASI]='" &amp; MyArrTPS(0).ToString &amp; "' " &amp; _
                        " 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) &amp; "\" &amp; MyArrTPS(1) &amp; vbCrLf &amp; rdr_DPT.GetValue(1) &amp; "-" &amp; rdr_DPT.GetValue(4)
                            With oSheet
                                NoUrut = NoUrut + 1
 
                                'If NoUrut &gt; 50 And (NoUrut Mod 25) = 1 Then rw = rw + 3

                                If NoUrut &gt; 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) &amp; Mid(rdr_DPT.GetValue(0), 7, 2)
                                Dim sTmpTgl As String = "0101001031"
                                Dim sNik As String = rdr_DPT.GetValue(2) &amp; ""
                                sNik = Replace(sNik, " ", "")
                                sNik = Trim(Replace(sNik, "+", ""))
 
                                If IsDate(rdr_DPT.GetValue(5)) Then
                                    sTmpTgl = Format(CDate(rdr_DPT.GetValue(5)), "ddMMyy") &amp; "100"
                                    If UCase(Trim(rdr_DPT.GetValue(8))) = "L" Then
                                        sTmpTgl = sTmpTgl &amp; "1"
                                    Else
                                        sTmpTgl = sTmpTgl &amp; "2"
                                    End If
                                End If
 
                                .Cells(12 + rw, 1) = NoUrut 'CDbl("0" &amp; rdr_DPT.GetValue(1))  'NoUrut

                                If Len(sNik) &lt; 16 Then
                                    sTmpNIK = "'" &amp; sTmpNIK &amp; sTmpTgl
                                Else
                                    sTmpNIK = "'" &amp; sNik
                                End If
 
                                .Cells(12 + rw, 2) = sTmpNIK
 
                                .Cells(12 + rw, 3) = rdr_DPT.GetValue(3)
                                .Cells(12 + rw, 4) = rdr_DPT.GetValue(4) &amp; ", " &amp; 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 = "&amp;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 = "&amp;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...
  Permalink  

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

  Print Answers RSS
0 OriginalGriff 455
1 Sergey Alexandrovich Kryukov 445
2 Maciej Los 290
3 ProgramFOX 275
4 CHill60 225
0 OriginalGriff 550
1 Sergey Alexandrovich Kryukov 470
2 Maciej Los 310
3 ProgramFOX 275
4 Peter Leow 250


Advertise | Privacy | Mobile
Web02 | 2.8.150331.1 | Last Updated 23 Feb 2013
Copyright © CodeProject, 1999-2015
All Rights Reserved. Terms of Service
Layout: fixed | fluid

CodeProject, 503-250 Ferrand Drive Toronto Ontario, M3C 3G8 Canada +1 416-849-8900 x 100