Hello all,
I know this query might have been asked many times in this forum but really appreciate if any one helps me out.
Problem Statement : i had to export the data stored in Excel to a Flex Grid and then to from Flex Grid to MS Access Table
Error Statement I''m Successfully copying the data from Excel and then Moving it to Flex Grid from Clip Board
Then Implemented a logic to transfer the data thru record set but a error pops up, I'm not very much sure why this is arising as an error
below is the code and the error screen shot
ERROR SCREEN
Run Time Error '3251
Current Record set dose not support updating, This may be a limitation of the provider, or of selected lockType
Error Screen.
I tried changing the lock type also but of no use
Looking forward for your Help
God Bless,
Thanks and Regards,
RavinderAttachment 98065
I know this query might have been asked many times in this forum but really appreciate if any one helps me out.
Problem Statement : i had to export the data stored in Excel to a Flex Grid and then to from Flex Grid to MS Access Table
Error Statement I''m Successfully copying the data from Excel and then Moving it to Flex Grid from Clip Board
Then Implemented a logic to transfer the data thru record set but a error pops up, I'm not very much sure why this is arising as an error
below is the code and the error screen shot
Code:
Private Sub CmdDBUpdate_Click()
Dim StrFilePath As String
Dim ExclApp As Excel.Application
Dim WorkBook As Excel.WorkBook
Dim WorkSheet As Excel.WorkSheet
Dim TotalRows As Integer
Dim intCol As Integer
Dim intRow As Integer
Dim UserName As String
Dim UserDomain As String
Dim StrDate As Date
' Option to give User to Select The Report File
CommonDialog.Filter = "Reports (*.xlsx)|*.xlsx|All files (*.*)|*.*"
CommonDialog.DefaultExt = "xlsx"
CommonDialog.DialogTitle = "Select File"
CommonDialog.ShowOpen
StrFilePath = CommonDialog.FileName
If StrFilePath = "" Then
Exit Sub
End If
' Error Handler to Check for Errors
'On Error GoTo ErrHandler
'Creat Instance Of Excel Application
Set ExclApp = CreateObject("Excel.Application")
'Don't Show Excel Application By Default Value needs to be keep False
ExclApp.Visible = False
'Turn Off Excel Dialog Alerts
ExclApp.DisplayAlerts = False
'//Open The WorkBook
Set WorkBook = ExclApp.Workbooks.Open(StrFilePath)
'//Create The WorkSheet
Set WorkSheet = WorkBook.Sheets.Add
WorkSheet.Name = "ComboData"
Set sht = WorkBook.Worksheets(2)
colCount = sht.Cells(1, 255).End(xlToLeft).Column
Me.ConvertToLetter (colCount)
' retrieve headers, no copy&paste needed
With WorkSheet.Cells(1, 1).Resize(1, colCount)
.Value = sht.Cells(1, 1).Resize(1, colCount).Value
'Set font as bold
.Font.Bold = True
End With
For Each ws In Worksheets
If ws.Name <> "ComboData" Then
'Range to be chaged dynamically
intCol = ws.Cells(1, 255).End(xlToLeft).Column
Me.ConvertToLetter (colCount)
intRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
If intRow < 2 Then
intRow = intRow + 1
End If
Rng = "A2:" & Me.ConvertToLetter(intCol) & intRow
ws.Range(Rng).Copy
Worksheets("MIPSComboData").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
intCol = ws.Cells(1, 255).End(xlToLeft).Column
ws.Columns("A:A").NumberFormat = "DD-MMM-YYYY"
'Me.ConvertToLetter (colCount + 1) & ws.Cells(Rows.Count, 1).End(xlUp).Row & ""
'ws.Range().Value =
'Ws("MIPSComboData").Cells(1, 2000000).NumberFormat = "DD-MMM-YYYY"
End If
Next ws
WorkSheet.Columns("A:A").NumberFormat = "DD-MMM-YYYY"
'With ExclApp.ActiveWorkbook.ActiveSheet
Set WorkSheet = ExclApp.ActiveWorkbook.ActiveSheet
MSFlexGrid1.Rows = WorkSheet.UsedRange.Rows.Count
MSFlexGrid1.Cols = WorkSheet.UsedRange.Columns.Count
WorkSheet.UsedRange.Copy
With Me.MSFlexGrid1
.Redraw = False
.Row = 0
.Col = 0
.RowSel = .Rows - 1
.ColSel = .Cols - 1
.Clip = Replace(Clipboard.GetText, vbNewLine, vbCr)
.Col = 1
.Redraw = True
End With
'Filled the Grid now to DataTransfer by Record Set
ExclApp.DisplayAlerts = False
WorkBook.Close
ExclApp.Application.Quit
Set WorkBook = Nothing
Set WorkSheet = Nothing
Set ExclApp = Nothing
Dim Cn As New ADODB.Connection
Dim RS1 As New ADODB.Recordset
Dim i As Integer
'Connection Established to database - MIPS
strCNString = "Data Source=" & ConnectionDBString
Cn.Provider = "Microsoft.ACE.OLEDB.12.0"
Cn.ConnectionString = strCNString
'cn.Properties("Jet OLEDB:Database Password") = "XYZ" will put if DB needs to be Password Protected
Cn.Open
RS1.Open "Select * From MasterData", Cn, adOpenDynamic, adLockOptimistic
', adCmdTable
For i = 1 To MSFlexGrid1.Rows - 1
'//ERROR COMING when i add new ROW TO RECORD SET WHICH IS PASTED BELOW
RS1.AddNew
'Col1 of master table is a unique id which is generated by a Autonumber
'RS1("Col2 of Master Table") = MSFlexGrid1.TextMatrix(i, 0)
'RS1("Col3 of Master Table") = MSFlexGrid1.TextMatrix(i, 1)
'RS1("Col4 of Master Table") = MSFlexGrid1.TextMatrix(i, 2)
'RS1("Col 5 of Master Table") = DateValue(Now)
'RS1("Col 6 of Master Table") = Environ("USERNAME") & " | " & Environ("USERDOMAIN")
'RS1.Update
Next
MsgBox "Database had been updated"
'--------------------------------------------------------------------------------------------------------------
RS1.Close
Cn.Close
'--------------------------------------------------------------------------------------------------------------
End SubRun Time Error '3251
Current Record set dose not support updating, This may be a limitation of the provider, or of selected lockType
Error Screen.
I tried changing the lock type also but of no use
Looking forward for your Help
God Bless,
Thanks and Regards,
RavinderAttachment 98065