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 18:50pm
Edited 22-Feb-13 3: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
 
        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...
  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 7,280
1 Sergey Alexandrovich Kryukov 6,059
2 Maciej Los 3,579
3 Peter Leow 3,383
4 CHill60 2,522


Advertise | Privacy | Mobile
Web03 | 2.8.140721.1 | Last Updated 23 Feb 2013
Copyright © CodeProject, 1999-2014
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