none
plz help in vb6.0 RRS feed

  • General discussion

  • i have a code for insert data in access from excel as following.

    when i execute code more then 1 time error  like 

    Runtime Error 1004 Method 'Worksheets' of object '_Global' failed

    i have code here  plz specify where in error i am beginor in vb

    Option Explicit
    Dim excel_app As Object
    Dim excel_sheet As Object
    Dim max_row As Integer
    Dim max_col As Integer
    Dim row As Integer
    Dim col As Integer
    Dim conn As ADODB.Connection
    Dim statement As String
    Dim new_value As String
    Dim st As String
    Dim ErrorMessage As Label
    Dim vbresult As VbMsgBoxResult
    Public str As String
    Private Sub cmdLoad1_Click()
    complet.Visible = True
       cmdselectpath.Enabled = False
           str = "Data Uploading In Progress..."
       complet.Caption = str
     
    'On Error GoTo ErrorMessage
        '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
            DoEvents
        Set excel_app = CreateObject("Excel.Application")    ' Uncomment this line to make Excel visible.'    excel_app.Visible = True
        excel_app.Workbooks.Open FileName:=txtExcelFile.Text '
        If Val(excel_app.Application.Version) >= 8 Then
            'Set excel_sheet = excel_app.ActiveSheet
           Set excel_sheet = Worksheets("familydetails")  here erroe occur
        Else
            Set excel_sheet = excel_app
        End If
        max_row = excel_sheet.UsedRange.Rows.Count  ' Get the last used row and column.
        max_col = excel_sheet.UsedRange.Columns.Count
        'Open the Access database.
       Set conn = New ADODB.Connection
    conn.ConnectionString = "Provider = Microsoft.Jet.OLEDB.4.0; data source=" & App.Path & "\KYC.mdb; User id = Admin; Persist Security Info= false; JET OLEDB:Database Password = brt@manoj.com"
    conn.Open
        ' Loop through the Excel spreadsheet rows,
        ' skipping the first row which contains
        ' the column headers.
        For row = 2 To max_row
            ' Compose an INSERT statement.
            statement = "INSERT INTO tblpersonal_family VALUES ("
            For col = 1 To max_col
                If col > 1 Then statement = statement & ","
                new_value = Trim$(excel_sheet.Cells(row, col).Value)
                  If IsNumeric(new_value) Then
                  statement = statement & _
                    new_value
                 
                   Else
                    statement = statement & _
                        "'" & _
                        new_value & _
                        "'"
              End If
                   
            Next col
            statement = statement & ")"   ' Execute the INSERT statement.
            conn.Execute statement, , adCmdText
        Next row
      conn.Close  ' Close the database.
     Set conn = Nothing    ' Comment the Close and Quit lines to keep    ' Excel running so you can see it.    ' Close the workbook saving changes.
         excel_app.ActiveWorkbook.Close True
     
       ' 'excel_app.Worksheets("uploadsheet1").Close True
       excel_app.Quit
       Set excel_sheet = Nothing
       Set excel_app = Nothing
                  
        MsgBox "Copied " & Format$(max_row - 1) & " values."
       cmdLoad1.Enabled = False
       cmdselectpath.Enabled = True
       Form2.Visible = True
              complet.Caption = ""
              MsgBox "Next"
                    If vbOK Then
                    Form6.Visible = True
                    End If
    'ErrorMessage:     MsgBox "Please Check Data Duplicate"
    End Sub


    • Edited by raju4545 Thursday, January 22, 2015 7:39 AM
    Thursday, January 22, 2015 7:38 AM

All replies

  • Try using a workbook object - bolded lines are added or changed

     

    'New object
    Dim WB As Workbook

    Private Sub cmdLoad1_Click()
    complet.Visible = True
       cmdselectpath.Enabled = False
           str = "Data Uploading In Progress..."
       complet.Caption = str

    'On Error GoTo ErrorMessage
        '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
            DoEvents
        Set excel_app = CreateObject("Excel.Application")    ' Uncomment this line to make Excel visible.'    excel_app.Visible = True

    'Changed line

       Set WB = excel_app.Workbooks.Open(Filename:=txtExcelFile.Text) '

    'Not sure what txtExcelFile is - assuming a textbox on a userform   

    If Val(excel_app.Application.Version) >= 8 Then
            'Set excel_sheet = excel_app.ActiveSheet
           Set excel_sheet = WB.Worksheets("familydetails")  'here erroe occur


    Thursday, January 22, 2015 1:51 PM