import data from excel formate

[ranjan84]

Dear Sir !
First of all thank for giving change to joint this board.You are doing grate job.keep it up.
I used office 2003 . i capture data from excel and import to access table.seince i used office 2010 i cannot capture data.(there are no action)
this is the vsb code i used so far. please could you help me to solve it.please see below the vsb code.

Thank you in advance.
Ranjan
Sub Import_Excel_Data()
On Error GoTo Import_Excel_Data_Err

Dim FSO
Dim LogPath
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim rstLKP As DAO.Recordset
Dim nTotal1 As Long
Dim nTotal2 As Long
Dim sFileName As String
Dim sMsg As String
Dim sSql As String
Dim nMaxId1 As Long
Dim nMaxId2 As Long
Dim bNewBatch As Boolean
Dim bLink_Success As Boolean

'Get the total # records already imported to Access DB
Set db = CurrentDb
sSql = "SELECT Max(CONSOWU.Id) AS MaxId, Count(CONSOWU.Id) AS TotalRecords " & _
"FROM CONSOWU;"
Set rst = db.OpenRecordset(sSql, dbOpenSnapshot)
nTotal1 = rst![TotalRecords]
nMaxId1 = Nz(rst![MaxId], 0)

sMsg = "Is this a New File to Import"
bNewBatch = False
If MsgBox(sMsg, vbYesNo + vbDefaultButton2 + vbQuestion, "New File...") = vbYes Then
bNewBatch = True
End If

'Set the path the Excel File. Remember to put \ at the end
' LogPath = "A:\"
LogPath = "j:\"


sMsg = "Enter input File Name to read from folder " & LogPath & vbCrLf & vbCrLf & "Press Cancel to exit"
sFileName = InputBox(sMsg, "File to Read", "CONSOWU.xls")
If sFileName = "" Then
Exit Sub
ElseIf Dir(LogPath + sFileName) = "" Then
MsgBox "File doesn't exist in folder " & LogPath
Exit Sub
End If
'Get confirmation whether to continue
If MsgBox("Do you want to continue", vbYesNo + vbQuestion, "Confirm") = vbYes Then
'Link the excel file
bLink_Success = Link_ExcelFile(LogPath + sFileName)
If Not bLink_Success Then Exit Sub
'Set the warnings off. This will not display the warning error message if the same table is imported twice
'The error is displayed because of primary key definition
DoCmd.SetWarnings False
' DoCmd.TransferSpreadsheet acImport, 5, "New_Consowu_2009", "G:\old hard drive\F\Ranjan\Jan-2009\031-120408-120408-CP-505WUMGTRAN.XLS", True, ""
db.Execute ("Import_Excel_Data")
DoCmd.SetWarnings True
'Get the total records after the insert
rst.Requery
nTotal2 = rst![TotalRecords]
nMaxId2 = rst![MaxId]

If nTotal2 > nTotal1 Then
If bNewBatch Then
Set rstLKP = db.OpenRecordset("TBL_lookup", dbOpenDynaset)
rstLKP.FindFirst "[LKP_Description] = 'Last_Batch_Max_Id'"
If rstLKP.NoMatch Then
rstLKP.AddNew
rstLKP![LKP_Description] = "Last_Batch_Max_Id"
rstLKP![lkp_Value] = CStr(nMaxId1)
rstLKP.Update
Else
rstLKP.Edit
rstLKP![lkp_Value] = CStr(nMaxId1)
rstLKP.Update
End If


rstLKP.MoveFirst
rstLKP.FindFirst "[LKP_Description] = 'Total_Records_B4_Last_Batch'"
If rstLKP.NoMatch Then
rstLKP.AddNew
rstLKP![LKP_Description] = "Total_Records_B4_Last_Batch"
rstLKP![lkp_Value] = CStr(nTotal1)
rstLKP.Update
Else
rstLKP.Edit
rstLKP![lkp_Value] = CStr(nTotal1)
rstLKP.Update
End If
rstLKP.Close
End If
End If

MsgBox CStr(nTotal2 - nTotal1) & " Records Appended successfully to CONSOWU Table", vbInformation, "Summary"
db.Execute ("UPDATE CONSOWU Set SEND_RECV = 'RECV' Where SEND_RECV = 'WU RCVD'")
db.Execute ("UPDATE CONSOWU Set SEND_RECV = 'SEND' Where SEND_RECV = 'WU SEND'")
' Kill (LogPath + sFileName)
Else
MsgBox "Records NOT appended to the table", vbCritical
End If

rst.Close
Import_Excel_Data_Exit:
Exit Sub

Import_Excel_Data_Err:
MsgBox Error

End Sub
Function Link_ExcelFile(sFileName As String) As Boolean
On Error GoTo LinkTable_Err
Dim sLinkDb As String
Dim rst As DAO.Recordset
Dim db As DAO.Database

sTableName = "XL"
DoCmd.DeleteObject acTable, sTableName

DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel8, sTableName, sFileName, True
Link_ExcelFile = True

LinkTable_Exit:
Exit Function
LinkTable_Err:
Select Case Err
Case 3011
Resume Next
Case 7874 ''When deleting link table, table is not linked
Resume Next
Case Else
MsgBox Error
Resume LinkTable_Exit
End Select
End Function
Function LinkTable() As Boolean
On Error GoTo LinkTable_Err
Dim sLinkDb As String
Dim rst As DAO.Recordset
Dim db As DAO.Database

Set db = CurrentDb
Set rst = db.OpenRecordset("Select lkp_value from TBL_Lookup where lkp_description = 'Wu_MOT_DB_Path';", dbOpenSnapshot)
If rst.EOF And rst.BOF Then
MsgBox "WU Database cannot be linked. Please enter the path with database name in tbl_lookup for lkp_description = Wu_MOT_DB_Path", vbInformation
LinkTable = False
Exit Function
End If
sLinkDb = rst![lkp_Value]
sTableName = "wu mot"
rst.Close

DoCmd.DeleteObject acTable, sTableName

DoCmd.TransferDatabase acLink, "Microsoft Access", sLinkDb, acTable, sTableName, sTableName, False
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel8, sTableName, filename, True
LinkTable = True

LinkTable_Exit:
Exit Function
LinkTable_Err:
Select Case Err
Case 3011
Resume Next
Case 7874 ''When deleting link table, table is not linked
Resume Next
Case Else
MsgBox Error
Resume LinkTable_Exit
End Select
End Function