Can you explain little bit more. and what you had tryed till now?
Thanks for shwoing intrest in my question, below i m mentioning the code which i wrote, which help u to solve my proble ;
Private Function UploadExcel() As Boolean
On Error GoTo Err
Dim rstemp As New ADODB.Recordset
Dim rsupload As New ADODB.Recordset
Dim rssrno As New ADODB.Recordset
Dim objexcel As Object
Dim strsql As String
Dim strfilename As String
Dim intcount As Integer, x As Long
Dim strfname As String, strlname As String, strsrno As String
conn.Open
'cn.Open
rsupload.CursorLocation = adUseClient
rstemp.CursorLocation = adUseClient
rssrno.CursorLocation = adUseClient
' UploadExcel = False
'strfilename = frmInputBox.InputString("Select upload file", "Upload File...", "", , "xls")
'strfilename = InputBox("Select excel file for Upload", "Upload File...", "", "xls")
'strfilename = InputBox("Select upload file", "Upload File...", "", , "xls") 'PLEASE CHECK THE PARAMETER SEQUENCE
strfilename = InputBox("Select Upload File", "Upload Files....", "")
MsgBox "File Uploading Started", vbOKOnly + vbInformation, "Uploading"
If Trim(strfilename) <> "" Then
Screen.MousePointer = vbHourglass
Set objexcel = GetObject(Trim(strfilename), "Excel.Sheet")
strsql = "select * from School.mdb"
'rsupload.Open strsql, conn, adOpenDynamicm, adLockOptimistic
rsupload.Open strsql, conn, adOpenStatic, adLockOptimistic, adCmdTable
intcount = 0
x = 1
Do While Not (objexcel.ActiveSheet.Range("A" & CStr(x)) = "")
If Not objexcel Is Nothing Then
intcount = incount + 1
x = intcount
If ((x = 1) And ((objexcel.ActiveSheet.Range("A" & CStr(1))) <> "SrNo")) Then
Screen.MousePointer = vbDefault
MsgBox "Not Appropriate file", vbCritical + vbOKOnly, "Upload Excel File Error"
rsupload.Close
' changeuploadstatus ("N")
Set rsupload = Nothing
Set objexcel = Nothing
Exit Function
End If
'---------------------------------------------------------------------------
If objexcel.ActiveSheet.Range("A" & CStr(x)) <> "SrNo" Then
strsrno = obsjexcel.ActiveSheet.Range("A" & CStr(x))
strfname = objexcel.ActiveSheet.Range("B" & CStr(x))
strlname = objexcel.ActiveSheet.Range("C" & CStr(x))
'Insert into Table1 (Srno,firstname,lastname) values('" & strsrno &'", '"&strfname&'", '"&strlname&'")
strsql = "Insert Into Table1 (SrNo, firstname, lastname)values('" & strsrno & "', '" & strfname & "','" & strlaname & "')"
conn.Execute strsql
End If
End If
x = x + 1
Loop
Else
UploadExcel = False
Screen.MousePointer = vbDefault
End If
If rsupload.State = adStateOpen Then rsupload.Close
If rssrno.State = adStateOpen Then rssrno.Close
Set rssrno = Nothing
Set rsupload = Nothing
Set objexcel = Nothing
Exit Function
Err:
Screen.MousePointer = vbDefault
MsgBox Err.Number & ": " & Err.Description, vbOKOnly + vbCritical, "UploadexcelFile error..."
UploadExcel = False
Resume
rsupload.Close
rssrno.Close
Set rssrno = Nothing
Set rsupload = Nothing
Set objexcel = Nothing
End Function
24
