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