Read Data from Excel (VB Code)

Private Sub cmd_browse_Click()
On Error Resume Next
Dim FNum As Integer
Dim txt As Recordset
On Error GoTo FileError
CommonDialog1.CancelError = True
CommonDialog1.Flags = cdlOFNFileMustExist
CommonDialog1.DefaultExt = "xls"
CommonDialog1.Filter = "Excel file|*.xls|*.*"
CommonDialog1.ShowOpen
FNum = FreeFile
pathtxt.Text = CommonDialog1.FileName
Close #FNum
Dim cnExcel As New ADODB.Connection
Dim rs As New ADODB.Recordset
With cnExcel
.Provider = "Microsoft.Jet.OLEDB.4.0"
'.ConnectionString = "Data Source=" & App.Path & "Contact.xls;" & "Extended Properties=Excel 8.0;"
.ConnectionString = "Data Source='" & pathtxt.Text & "';Extended Properties=Excel 8.0;"
.Open
End With
Dim strQuery As String
strQuery = "SELECT * FROM [Sheet1$]"
rs.Open strQuery, cnExcel, adOpenStatic, adLockReadOnly
'totaltxt.Text = rs.RecordCount
'MsgBox "Total records: " & rs.RecordCount
'MsgBox "Reading first record..."
'MsgBox "ID: " & rs(i)
'MsgBox "NAME: " & rs(j)
'MsgBox "AGE: " & rs(k)
'MsgBox "Saving into Access..."
Dim cnAccess As New ADODB.Connection
With cnAccess
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & App.Path & "temp.mdb;"
.Open
End With
Dim cmdAccess As New ADODB.Command
cmdAccess.ActiveConnection = cnAccess
If rs.EOF = False Then
On Error Resume Next
Dim i As Integer
For i = 0 To rs.RecordCount
cmdAccess.CommandText = "Insert into table1 values ('" & rs(0) & "','" & rs(1) & "','" & rs(2) & "','" & rs(3) & "','" & rs(4) & "','" & rs(5) & "','" & rs(6) & "','" & rs(7) & "','" & rs(8) & "','" & rs(9) & "','" & rs(10) & "','" & rs(11) & "')"
cmdAccess.Execute
rs.MoveNext
Next
End If
Call totalrecordcount
Call droptb
Call temptb
Call countrecorsd
cmdprint.Enabled = True
cmd_browse.Enabled = False
MsgBox "Data Successfully Transfer to temp.mdb", vbInformation
'Call cmddel_Click
FileError:
If Err.Number = cdlCancel Then Exit Sub
End Sub

Share on Facebook

Post on X

Follow us

Save