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
