contoh kode untuk membaca data dari exel
most-c :: Pemrograman :: Visual Basic
Halaman 1 dari 1
contoh kode untuk membaca data dari exel
Private Sub GetColumns(ByVal Index As Integer)
Dim i As Integer
On Error GoTo ErrorhHandle
Dim rst As ADODB.Recordset
Dim rsC As ADODB.Recordset
Dim clm As ColumnHeader
Screen.MousePointer = vbHourglass
If Not gy_cnnXLS Is Nothing Then
If gy_cnnXLS.State > 0 Then
lsvRecordset.ListItems.Clear
lsvRecordset.ColumnHeaders.Clear
Set rst = gy_cnnXLS.OpenSchema(adSchemaTables)
If Not rst Is Nothing Then
If rst.State > 0 Then
If rst.RecordCount > 0 Then
For i = 0 To rst.RecordCount - 1
If Index = i Then
Set rsC =
gy_cnnXLS.OpenSchema(adSchemaColumns, Array(Empty, Empty,
Trim(rst.Fields("TABLE_NAME").Value & vbNullString), Empty))
If Not rsC Is Nothing Then
If rsC.State > 0
Then
txtColumn.Text = CStr(rsC.RecordCount)
If rsC.RecordCount > 0 Then
While Not rsC.EOF
Set clm = lsvRecordset.ColumnHeaders.Add
clm.Text = Trim(rsC.Fields("COLUMN_NAME").Value & vbNullString)
clm.Tag = "0"
If lsvRecordset.ColumnHeaders.Count = 1 Then
lsvRecordset.ColumnHeaders(1).Icon = (lsvRecordset.SortOrder + 1)
rsC.MoveNext
Wend
Set clm = Nothing
End If
rsC.Close
End If
Set rsC = Nothing
End If
Exit For
End If
rst.MoveNext
Next
End If
rst.Close
End If
Set rst = Nothing
End If
End If
End If
Screen.MousePointer = vbDefault
Exit Sub
ErrorhHandle:
MsgBox CutMSG(Err.Description)
End Sub
sumber http://vb-bego.net/forum/viewtopic.php?f=11&t=1302&start=0&st=0&sk=t&sd=a&sid=47453310b521ccb4d0a1812faa291425
Dim i As Integer
On Error GoTo ErrorhHandle
Dim rst As ADODB.Recordset
Dim rsC As ADODB.Recordset
Dim clm As ColumnHeader
Screen.MousePointer = vbHourglass
If Not gy_cnnXLS Is Nothing Then
If gy_cnnXLS.State > 0 Then
lsvRecordset.ListItems.Clear
lsvRecordset.ColumnHeaders.Clear
Set rst = gy_cnnXLS.OpenSchema(adSchemaTables)
If Not rst Is Nothing Then
If rst.State > 0 Then
If rst.RecordCount > 0 Then
For i = 0 To rst.RecordCount - 1
If Index = i Then
Set rsC =
gy_cnnXLS.OpenSchema(adSchemaColumns, Array(Empty, Empty,
Trim(rst.Fields("TABLE_NAME").Value & vbNullString), Empty))
If Not rsC Is Nothing Then
If rsC.State > 0
Then
txtColumn.Text = CStr(rsC.RecordCount)
If rsC.RecordCount > 0 Then
While Not rsC.EOF
Set clm = lsvRecordset.ColumnHeaders.Add
clm.Text = Trim(rsC.Fields("COLUMN_NAME").Value & vbNullString)
clm.Tag = "0"
If lsvRecordset.ColumnHeaders.Count = 1 Then
lsvRecordset.ColumnHeaders(1).Icon = (lsvRecordset.SortOrder + 1)
rsC.MoveNext
Wend
Set clm = Nothing
End If
rsC.Close
End If
Set rsC = Nothing
End If
Exit For
End If
rst.MoveNext
Next
End If
rst.Close
End If
Set rst = Nothing
End If
End If
End If
Screen.MousePointer = vbDefault
Exit Sub
ErrorhHandle:
MsgBox CutMSG(Err.Description)
End Sub
sumber http://vb-bego.net/forum/viewtopic.php?f=11&t=1302&start=0&st=0&sk=t&sd=a&sid=47453310b521ccb4d0a1812faa291425
most-c :: Pemrograman :: Visual Basic
Halaman 1 dari 1
Permissions in this forum:
Anda tidak dapat menjawab topik
|
|