Results 1 to 3 of 3

Thread: Error While Exporting the Data from Flexgrid to MS Access Table

  1. #1

    Thread Starter
    New Member
    Join Date
    Mar 2013
    Posts
    9

    Error While Exporting the Data from Flexgrid to MS Access Table

    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
    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 Sub
    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,

    RavinderName:  Error Screen - 1.jpg
Views: 224
Size:  27.0 KB

  2. #2
    PowerPoster
    Join Date
    Feb 2012
    Location
    West Virginia
    Posts
    14,205

    Re: Error While Exporting the Data from Flexgrid to MS Access Table

    Where is the database file and what OS are you using?

    My guess would be the the file is in a location where you do not have write permissions.

  3. #3

    Thread Starter
    New Member
    Join Date
    Mar 2013
    Posts
    9

    Re: Error While Exporting the Data from Flexgrid to MS Access Table

    Hey Miser,

    you were correct i didn't have rights to update the database file, i was using the access file which is available in code as a ConnectionDBString , also i changes the Cursor location to Aduser client and same started working.

    Thanks for Help

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width