Kalau mau Import dari Excel pake' cara ini mungkin lebih simpel, Dim cnExcell As New ADODB.Connection, rs As New ADODB.Recordset SQL = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = Letak_File\Nama_File.xls;Extended Properties = Excel 8.0" cnExcell.ConnectionString = SQL cnExcell.CursorLocation = adUseClient cnExcell.Open
SQL = "SELECT * FROM [Nama_Sheet$]" rs.CursorLocation = adUseClient rs.Open SQL, cnExcell, adOpenKeyset, adLockBatchOptimistic MsgBox rs.RecordCount Set GridEX1.ADORecordset = rs Dengan cara itu walaupun file excelnya di buka masih bisa, akan tetapi kalau file excelnya lagi di edit nggak bisa.. semoga membantu ----- Original Message ----- From: iyar To: [email protected] Sent: Tuesday, January 30, 2007 4:16 PM Subject: [Programmer-VB] Import data excel Halo temen2 saya mau minta tolong nich selama ini saya selalu import data excel dengan cara di apploud ke data grid kemudian di save.Ada satu kendala setiap saya mau appload data excel ke data grid saya tidak boleh membuka file excel.karena setiap aku buka pasti error programnya. programnya seperti ini : Private Sub CmdImport_Click() On Error GoTo errhandler: On Error Resume Next: Dim appWorld As Excel.Application Dim wbWorld As Excel.Workbook Dim shtImport As Excel.Worksheet Dim rngList As Excel.Range Dim intFirstBlankCell As Integer Dim loop1 As Integer Dim s As String Dim jumlah, X CommonDialog1.filename = "" CommonDialog1.Filter = "*.xls|*.XLS" CommonDialog1.ShowOpen s = Right(CommonDialog1.filename, 26) If Mid(s, 1, 2) = "bm" Then Set appWorld = GetObject(, "Excel.Application") 'look for a running copy of Excel If Err.Number <> 0 Then 'If Excel is not running then Set appWorld = CreateObject("Excel.Application") 'run it End If Err.Clear ' Clear Err object in case error occurred. On Error GoTo 0 'Resume normal error processing Set wbWorld = appWorld.Workbooks.Open(CommonDialog1.filename) Set shtImport = wbWorld.Sheets(1) ' Assign the first row of this sheet to an object. Set rngList = shtImport.Rows(1) ' See if it's an empty list. If (rngList.Cells(1, 16) = "") Then intFirstBlankCell = 0 Else ' Search the row for the first blank cell. i = 1 While rngList.Cells(i, 16) <> "" rs.Open "select * from trbrg_masuk where no_brgmsk='" & rngList.Cells(i, 16) & "'", con, adOpenKeyset, adLockOptimistic If rs.BOF = False Then MsgBox "Data sudah pernah diambil ", vbCritical + vbOKOnly, "Programmer Message" rs.Close shtImport.Application.Quit appWorld.Quit Set appWorld = Nothing Set wbWorld = Nothing Set shtImport = Nothing Set rngList = Nothing Exit Sub End If rs.Close intFirstBlankCell = intFirstBlankCell + 1 i = i + 1 Wend End If con.BeginTrans ' Add the items to the features combo box. jumlah = 0 For loop1 = 1 To intFirstBlankCell SSOleDBGrid1.AddItem rngList.Cells(loop1, 1) & "," & rngList.Cells(loop1, 2) & "," & rngList.Cells(loop1, 3) & "," _ & rngList.Cells(loop1, 4) & "," & rngList.Cells(loop1, 5) & "," & rngList.Cells(loop1, 6) & "," & rngList.Cells(loop1, 7) & "," & rngList.Cells(loop1, 8) & "," _ & rngList.Cells(loop1, 9) & "," & rngList.Cells(loop1, 10) & "," & rngList.Cells(loop1, 11) & "," & rngList.Cells(loop1, 12) & "," & rngList.Cells(loop1, 13) & "," _ & rngList.Cells(loop1, 14) & "," & rngList.Cells(loop1, 15) & "," & rngList.Cells(loop1, 16) & "," & rngList.Cells(loop1, 17) & "," & rngList.Cells(loop1, 18) & "," _ & rngList.Cells(loop1, 19) & "," & rngList.Cells(loop1, 20) & "," & rngList.Cells(loop1, 21) & "," & rngList.Cells(loop1, 22) & "," & rngList.Cells(loop1, 23) & "," _ & rngList.Cells(loop1, 24) & "," & rngList.Cells(loop1, 25) & "," & rngList.Cells(loop1, 26) & "," & rngList.Cells(loop1, 27) & "," & rngList.Cells(loop1, 28) & "," _ & rngList.Cells(loop1, 29) & "," & rngList.Cells(loop1, 30) & "," & rngList.Cells(loop1, 31) jumlah = jumlah + 1 intFirstBlankCell = intFirstBlankCell + 1 Next If SSOleDBGrid1.Rows <> 0 Then Cmdselesai.Enabled = False cmdimport.Enabled = False Cmdsimpan.Enabled = True Cmdbatal.Enabled = True Else tombolAwal End If shtImport.Application.Quit appWorld.Quit Set appWorld = Nothing Set wbWorld = Nothing Set shtImport = Nothing Set rngList = Nothing lbltotal.Caption = Format(jumlah, "#,##0") con.CommitTrans Else If s <> "" Then MsgBox "Anda salah mengambil Data !!", vbExclamation + vbOKOnly, "Programmer Message" End If End If Exit Sub errhandler: con.RollbackTrans MsgBox Err.Description, vbCritical + vbOKOnly, "Programmer Message" End Sub Ada yang bisa bantu ?? terima kasih Send instant messages to your online friends http://uk.messenger.yahoo.com
