Hi,
Do u run this Upload Program in a Multi-User Envi.
Say, 2 people are trying to upload same file at same time..?
If yes, then u will have to do some kind of Table-Locking..
And to what Backend DB u r exporting?
How did u open the Excel? Excel Object or using ADO?
What creiteria u use to check if it is End of File /Range in Excel..?
Can u paste the code here?
Regards
Veena
It's a single user env.
Backend DB is SQL server.
I am opening Excel obejct.
I am using mObjWorkSheet.Cells(1, 1).CurrentRegion.ROWS.count
to find out the number of rows and then inserting each record one by one.
The actual code is very big so I am pasting the main method here
Private Sub UploadNormalTables()
'Objects to store the count of non-RI tables
Dim intTableCount As Integer
'Object to store the table name
Dim strTableName As String
'Object to store the filepath of the table
Dim strFilePath As String
'Object to store the number of rows present in the SQL table
Dim intNumOfRows As Long
'objects used as counters
Dim intCounter1 As Long
Dim intCounter2 As Long
'Object to store the error message
Dim strErrorMsg As String
'Flag to check whether the table is empty
Dim blnTableEmpty As Boolean
'Object to store the Table names not uploaded successfully
Dim strTablesNotUploaded As String
'Flag to check for error condition if any
Dim intIsError As Integer
'Flag to check if the column names of XLS and the database are in the
'same sequence
Dim blnColumnNamesInSeq As Boolean
intIsError = 0
strTablesNotUploaded = ""
For intCounter1 = 0 To mIntNormalTablesCount - 1
mIntErrorInLine = 0
On Error GoTo ErrorInXLS1
strTableName = ""
strTableName = mStrNormalTableList(intCounter1)
mStrQuery = ""
intNumOfRows = 0
'-------------------Logic to open the xls file selected by the user--------------
strFilePath = mStrNormalTablePath(intCounter1)
Set mObjExel = CreateObject("Excel.Application")
Set mObjWorkBook = mObjExel.Workbooks.Open _
(FileName:=strFilePath, ReadOnly:=True)
If intIsError <> 0 Then
intIsError = 0
GoTo GetNextWorkBook1
End If
Set mObjWorkSheet = mObjWorkBook.Worksheets(mObjWorkBook.ActiveSheet.N ame)
GoTo ProcessFurther1
ErrorInXLS1:
mIntNumOfTblNotUploaded = mIntNumOfTblNotUploaded + 1
mStrErrorMessage = mIntNumOfTblNotUploaded & ". " & _
mStrErrorMessage & mStrNormalTableList(intCounter1) & _
gStrErrMsg129 & vbCrLf & "Error in opening Excel File"
intIsError = 1
Resume Next
ProcessFurther1:
On Error GoTo ErrorInNormalTblProcessing
'Starting the Transaction to upload the table
gConn.BeginTrans
'To fetch the number of rows and columns in the Excel Sheet
mIntNumOfRows = mObjWorkSheet.Cells(1, 1).CurrentRegion.ROWS.count
mIntNumOfCols = mObjWorkSheet.Cells(1, 1).CurrentRegion.Columns.count
'If there is no data in the table
If mIntNumOfRows < 1 Then
strErrorMsg = strTableName & gStrErrMsg132
GoTo ErrorInNormalTblProcessing
End If
'function to fetch the data type for all the column from the DB n store
'it in rs4 recordset
Call FetchAllColumnDataType(strTableName)
blnColumnNamesInSeq = False
'Function to check if the column names of XLS and SQL table are in
'the same sequence or not
blnColumnNamesInSeq = CheckColumnNamesInXLS
If blnColumnNamesInSeq = False Then
strErrorMsg = strTableName & gStrErrMsg130
GoTo ErrorInNormalTblProcessing
End If
'function to delete all the rows from the table
Call TruncateTable(strTableName)
'function to insert the rows into SQL database
For intCounter2 = 0 To mIntNumOfRows - 2
Call InsertRowInDB(intCounter2 + 2, strTableName)
Next intCounter2
mIntTablesUploaded = mIntTablesUploaded + 1
'Commit Transaction in case of no error in processing
GoTo CommitTransaction1
ErrorInNormalTblProcessing:
'Rollback uploading of data in case of error
gConn.RollbackTrans
mIntNumOfTblNotUploaded = mIntNumOfTblNotUploaded + 1
'Store the error message in the string
If mStrErrorMessage <> "" Then
mStrErrorMessage = mStrErrorMessage & vbCrLf & vbCrLf & _
mIntNumOfTblNotUploaded & ". "
Else
mStrErrorMessage = mIntNumOfTblNotUploaded & ". "
End If
mStrErrorMessage = mStrErrorMessage & strTableName & _
gStrErrMsg129 & vbCrLf
If strErrorMsg = "" Then
If mIntErrorInLine <> 0 Then
mStrErrorMessage = mStrErrorMessage & " Error in row : " & _
mIntErrorInLine & " " & Err.Description
Else
mStrErrorMessage = mStrErrorMessage & Err.Description
End If
Else
mStrErrorMessage = mStrErrorMessage & strErrorMsg
End If
If Err.Number = 0 Then
GoTo GetNextWorkBook1
Else
Resume GetNextWorkBook1
End If
CommitTransaction1:
'If no error while uploading, then commit transaction
gConn.CommitTrans
GetNextWorkBook1:
'------------------Closing all the recordsets---------------------------------
If rs.State = 1 Then
rs.Close
End If
If rs2.State = 1 Then
rs2.Close
End If
If rs3.State = 1 Then
rs3.Close
End If
If rs4.State = 1 Then
rs4.Close
End If
If rs5.State = 1 Then
rs5.Close
End If
'------------------- Closing to the Excel Sheet----------------------------------
mObjExel.ActiveWorkbook.Close
mObjExel.Quit
Next intCounter1
End Sub