Problem with code to extract data from excel to access 2010 (1 Viewer)

A

almagana07

New member
Local time
Today, 12:46
Joined
Aug 2, 2013
Messages
4
Hi,

I'm new to this forum, I've been struggling for some weeks now with a code to pull out some data from an excel template to my Access database, I got some help with the original code and then I did some upgrades, however, everytime I run it, I get all my information in the Access table as desired but the information is also overwritten in the main table on the first record, I have checked and re-checked with some colleagues but we can't find the reason, I hope someone here can help me, this is becoming very frustrating:

Code: 
Option Compare Database
Dim Contador As Integer
Dim sequential As String
Private Function Excel_a_AccessCCN(Path_BD As String, Path_XLS As String, La_Tabla As String) As Boolean
    Dim Obj_Excel       As Object
    Dim Obj_Hoja        As Object
    Dim bd              As DAO.Database
    Dim rst             As DAO.Recordset
    Dim rs              As DAO.Recordset
    Dim intResult       As Integer
    Dim strSQL          As String
 
    Dim Dato1      As String
    Dim Dato2      As Variant
    Dim Dato3      As Variant
    Dim Dato4      As Variant
    Dim Dato5      As Variant
    Dim Dato6      As Variant
    Dim Dato7      As Variant
    Dim Dato8      As Variant
    Dim Dato9      As Variant
    Dim Dato10     As Variant
    Dim Dato11     As Variant
    Dim Dato12     As Variant
    Dim Dato13     As Variant
 
    Dim SQL2 As String
 
    Screen.MousePointer = vbHourglass
 
    Set Obj_Excel = CreateObject("Excel.Application")
 
    Obj_Excel.Workbooks.Open FileName:=Path_XLS
 
        Set Obj_Hoja = Obj_Excel.Sheets("CCN-TCN-CIN Form")
 
        Set bd = OpenDatabase(Path_BD)
            Set rst = bd.OpenRecordset(La_Tabla, dbOpenTable)
 
        If Frame19.Value = 1 Then
            Dato1 = Trim$(Obj_Hoja.Cells(4, 4)) ' Identification #
        Else
            If Len(Text16.Value) = 1 Then
               sequential = "00" & Text16.Value
            ElseIf Len(Text16.Value) = 2 Then
               sequential = "0" & Text16.Value
            End If
            Dato1 = Text9.Value & "-" & Text11.Value & "-" & Format(Text13.Value, "yyyymm") & "-" & sequential
        End If
 
       SQL1 = "INSERT INTO CCN ( [Identification #] ) SELECT '" & Dato1 & "' AS Expr1"
    DoCmd.RunSQL SQL1
 
        Dato2 = Trim$(Obj_Hoja.Cells(6, 4)) ' Type of notice
        Dato3 = Trim$(Obj_Hoja.Cells(8, 4)) ' Region
        Dato4 = Trim$(Obj_Hoja.Cells(50, 4)) ' Risk Level
        Dato5 = Trim$(Obj_Hoja.Cells(65, 4)) ' Affected Areas
        Dato6 = Trim$(Obj_Hoja.Cells(6, 7)) ' CCN/TCN/CIN Date
        Dato7 = Trim$(Obj_Hoja.Cells(8, 7)) ' Publication Date
        Dato8 = Trim$(Obj_Hoja.Cells(50, 7)) ' Effective Date
        Dato9 = Trim$(Obj_Hoja.Cells(65, 7)) ' Response Due Date
        Dato10 = Trim$(Obj_Hoja.Cells(8, 10)) ' Prepared By
        Dato11 = Trim$(Obj_Hoja.Cells(50, 10)) ' Reviewed By
        Dato12 = Trim$(Obj_Hoja.Cells(69, 2)) ' Reference
        Dato13 = Trim$(Obj_Hoja.Cells(73, 2)) ' Description of Change
 
 
        SQL2 = "INSERT INTO CCN ( [Identification #], [Type of notice], [Region], [Risk Level], [Affected Areas], [CCN/TCN/CIN Date], [Publication Date], [Effective Date], [Response Due Date], [Prepared by], [Reviewed], [Reference], [Description of change] ) SELECT '" & Dato1 & "' AS Expr1, '" & Dato2 & "'AS Expr2, '" & Dato3 & "' AS Expr3, '" & Dato4 & "' AS Expr4, '" & Dato5 & "' AS Expr5, '" & Dato6 & "' AS Expr6, '" & Dato7 & "' AS Expr7, '" & Dato8 & "' AS Expr8, '" & Dato9 & "' AS Expr9, '" & Dato10 & "' AS Expr10, '" & Dato11 & "' AS Expr11, '" & Dato12 & "' AS Expr12, '" & Dato13 & "' AS Expr13;"
           DoCmd.RunSQL SQL2
 
 
 
        strSQL = "SELECT Count([CCN].[Identification #]) as RecordCount FROM [CCN] WHERE ([CCN].[Identification #] = '" & Dato1 & "');"
        Set rs = bd.OpenRecordset(strSQL, dbOpenSnapshot)
 
        intResult = rs("RecordCount")
        If intResult > 0 Then
            rst.Edit
                rst(1).Value = Dato2
                rst(2).Value = Dato3
                rst(3).Value = Dato4
                rst(4).Value = Dato5
                rst(5).Value = Dato6
                If Not IsNull(Dato7) And Not Dato7 = "" And Not Dato7 = "N/A" And Not Dato7 = "NA" And Not Dato7 = "TBD" And Not Dato7 = "None" Then
                    rst(6).Value = Dato7
                End If
                If Not IsNull(Dato8) And Not Dato8 = "" And Not Dato8 = "N/A" And Not Dato8 = "NA" And Not Dato8 = "TBD" And Not Dato8 = "None" Then
                    rst(7).Value = Dato8
                End If
                If Not IsNull(Dato9) And Not Dato9 = "" And Not Dato9 = "N/A" And Not Dato9 = "NA" And Not Dato9 = "TBD" And Not Dato9 = "None" Then
                    rst(8).Value = Dato9
                End If
                rst(9).Value = Dato10
                rst(10).Value = Dato11
                rst(11).Value = Dato12
                rst(12).Value = Dato13
            rst.Update
        Else
            rst.AddNew
                rst(0).Value = Dato1
                rst(1).Value = Dato2
                rst(2).Value = Dato3
                rst(3).Value = Dato4
                rst(4).Value = Dato5
                rst(5).Value = Dato6
                If Not IsNull(Dato7) And Not Dato7 = "" And Not Dato7 = "N/A" And Not Dato7 = "NA" And Not Dato7 = "TBD" And Not Dato7 = "None" Then
                    rst(6).Value = Dato7
                End If
                If Not IsNull(Dato8) And Not Dato8 = "" And Not Dato8 = "N/A" And Not Dato8 = "NA" And Not Dato8 = "TBD" And Not Dato8 = "None" Then
                    rst(7).Value = Dato8
                End If
                If Not IsNull(Dato9) And Not Dato9 = "" And Not Dato9 = "N/A" And Not Dato9 = "NA" And Not Dato9 = "TBD" And Not Dato9 = "None" Then
                    rst(8).Value = Dato9
                End If
                rst(9).Value = Dato10
                rst(10).Value = Dato11
                rst(11).Value = Dato12
                rst(12).Value = Dato13
            rst.Update
        End If
 
    rs.Close
    Excel_a_AccessCCN = True
 
    Call Descargar_Objetos(rst, bd, Obj_Excel, Obj_Hoja)
    Screen.MousePointer = vbDefault
 
Exit Function
ErrSub:
Call Descargar_Objetos(rst, bd, Obj_Excel, Obj_Hoja)
MsgBox Err.Description, vbCritical
Screen.MousePointer = vbDefault
 
End Function
Private Function Excel_a_AccessCCN1(Path_BD As String, Path_XLS As String, La_Tabla As String) As Boolean
    Dim Obj_Excel       As Object
    Dim Obj_Hoja        As Object
    Dim bd              As DAO.Database
    Dim rst             As DAO.Recordset
 
    Dim Dato1       As String
    Dim Dato2       As String
    Dim Dato3       As Variant
    Dim Dato4       As Variant
    Dim Dato5       As Variant
    Dim Dato6       As Variant
    Dim Dato7       As Variant
    Dim Dato8       As Variant
    Dim Dato9       As Variant
    Dim i           As Integer
    Dim rs              As DAO.Recordset
    Dim intResult       As Integer
    Dim strSQL          As String
    Dim SQL3 As String
    Dim SQL4 As String
 
    Screen.MousePointer = vbHourglass
 
    Set Obj_Excel = CreateObject("Excel.Application")
 
    Obj_Excel.Workbooks.Open FileName:=Path_XLS
 
        Set Obj_Hoja = Obj_Excel.Sheets("CCN-TCN-CIN Form")
 
        Set bd = OpenDatabase(Path_BD)
        Set rst = bd.OpenRecordset(La_Tabla, dbOpenTable)
 
        i = 0
        Dato2 = Trim$(Obj_Hoja.Cells(77, 2))
        Do While Not Dato2 = vbNullString
 
            If Frame19.Value = 1 Then
                Dato1 = Trim$(Obj_Hoja.Cells(4, 4)) ' Identification #
            Else
               If Len(Text16.Value) = 1 Then
                   sequential = "00" & Text16.Value
               ElseIf Len(Text16.Value) = 2 Then
                   sequential = "0" & Text16.Value
               End If
               Dato1 = Text9.Value & "-" & Text11.Value & "-" & Format(Text13.Value, "yyyymm") & "-" & sequential
            End If
            Dato2 = Trim$(Obj_Hoja.Cells(77 + i, 2)) ' Action
            Dato3 = Trim$(Obj_Hoja.Cells(77 + i, 3)) ' Actions to be Taken
            Dato4 = Trim$(Obj_Hoja.Cells(77 + i, 5)) ' Related Process
            Dato5 = Trim$(Obj_Hoja.Cells(77 + i, 6)) ' Type of Action
            Dato6 = Trim$(Obj_Hoja.Cells(77 + i, 7)) ' LI GTM Position
            Dato7 = Trim$(Obj_Hoja.Cells(77 + i, 8)) ' Responsible Person
            Dato8 = Trim$(Obj_Hoja.Cells(77 + i, 9)) ' Industry
            Dato9 = Trim$(Obj_Hoja.Cells(77 + i, 10)) ' Client
 
           SQL3 = "INSERT INTO CCN1 ( [Identification #], [Action], [Actions to be Taken], [Related Process], [Type of Action], [LI GTM Position], [Responsible Person], [Industry], [Client] ) SELECT '" & Dato1 & "' AS Expr1, '" & Dato2 & "' AS Expr2, '" & Dato3 & "' AS Expr3, '" & Dato4 & "' AS Expr4, '" & Dato5 & "' AS Expr5, '" & Dato6 & "' AS Expr6, '" & Dato7 & "' AS Expr7, '" & Dato8 & "' AS Expr8, '" & Dato9 & "' AS Expr9;"
DoCmd.RunSQL SQL3
 
            SQL4 = "DELETE CCN1.[Identification #], CCN1.Action FROM CCN1 WHERE (((CCN1.[Identification #]) Is Not Null) AND ((CCN1.Action)=' '));"
            DoCmd.RunSQL SQL4
 
 
 
 
            strSQL = "SELECT * FROM [CCN1] WHERE ([CCN1].[Identification #] = '" & Dato1 & "' AND [CCN1].[Action] = '" & Dato2 & "');"
            Set rs = bd.OpenRecordset(strSQL, dbOpenDynaset)
 
            intResult = rs.RecordCount
            If intResult > 0 Then
                rs.Edit
                    rs(2).Value = Dato3
                    rs(3).Value = Dato4
                    rs(4).Value = Dato5
                    rs(5).Value = Dato6
                    rs(6).Value = Dato7
                    rs(7).Value = Dato8
                    rs(8).Value = Dato9
 
 
                rs.Update
            Else
                rst.AddNew
                    rst(0).Value = Dato1
                    rst(1).Value = Dato2
                    rst(2).Value = Dato3
                    rst(3).Value = Dato4
                    rst(4).Value = Dato5
                    rst(5).Value = Dato6
                    rst(6).Value = Dato7
                    rst(7).Value = Dato8
                    rst(8).Value = Dato9
 
 
                'rst.Update
            End If
            i = i + 1
            Dato2 = Trim$(Obj_Hoja.Cells(77 + i, 2))
            Contador = i + 3
        Loop
 
    rs.Close
    Excel_a_AccessCCN1 = True
 
    Call Descargar_Objetos(rst, bd, Obj_Excel, Obj_Hoja)
    Screen.MousePointer = vbDefault
 
Exit Function
ErrSub:
Call Descargar_Objetos(rst, bd, Obj_Excel, Obj_Hoja)
MsgBox Err.Description, vbCritical
Screen.MousePointer = vbDefault
 
End Function
Private Function Excel_a_AccessCCN2(Path_BD As String, Path_XLS As String, La_Tabla As String) As Boolean
    Dim Obj_Excel       As Object
    Dim Obj_Hoja        As Object
    Dim bd              As DAO.Database
    Dim rst             As DAO.Recordset
 
    Dim Dato1       As String
    Dim Dato2       As String
    Dim Dato3       As Variant
    Dim Dato4       As Variant
    Dim Dato5       As Variant
    Dim Dato6       As Variant
    Dim i           As Integer
    Dim rs              As DAO.Recordset
    Dim intResult       As Integer
    Dim strSQL          As String
    Dim SQL4 As String
 
    Screen.MousePointer = vbHourglass
 
    Set Obj_Excel = CreateObject("Excel.Application")
 
    Obj_Excel.Workbooks.Open FileName:=Path_XLS
 
        Set Obj_Hoja = Obj_Excel.Sheets("CCN-TCN-CIN Form")
 
        Set bd = OpenDatabase(Path_BD)
        Set rst = bd.OpenRecordset(La_Tabla, dbOpenTable)
 
        i = 0
        Dato2 = Trim$(Obj_Hoja.Cells(77 + Contador, 2))
        Do While Not Dato2 = vbNullString
 
            If Frame19.Value = 1 Then
                Dato1 = Trim$(Obj_Hoja.Cells(4, 4)) ' Identification #
            Else
               If Len(Text16.Value) = 1 Then
                   sequential = "00" & Text16.Value
               ElseIf Len(Text16.Value) = 2 Then
                   sequential = "0" & Text16.Value
               End If
               Dato1 = Text9.Value & "-" & Text11.Value & "-" & Format(Text13.Value, "yyyymm") & "-" & sequential
            End If
            Dato2 = Trim$(Obj_Hoja.Cells(77 + Contador + i, 2)) ' Action
            Dato3 = Trim$(Obj_Hoja.Cells(77 + Contador + i, 3)) ' Action Taken
            Dato4 = Trim$(Obj_Hoja.Cells(77 + Contador + i, 6)) ' Response Date
            Dato5 = Trim$(Obj_Hoja.Cells(77 + Contador + i, 8)) ' Implementation Date
            Dato6 = Trim$(Obj_Hoja.Cells(77 + Contador + i, 10)) ' Client
 
 
            SQL4 = "INSERT INTO CCN2 ( [Identification #], [Action], [Action Taken], [Response Date], [Implementation Date], [Client] ) SELECT '" & Dato1 & "' AS Expr1, '" & Dato2 & "' AS Expr2, '" & Dato3 & "' AS Expr3, '" & Dato4 & "' AS Expr4, '" & Dato5 & "' AS Expr5, '" & Dato6 & "' AS Expr6;"
            DoCmd.RunSQL SQL4
 
            strSQL = "SELECT * FROM [CCN2] WHERE ([CCN2].[Identification #] = '" & Dato1 & "' AND [CCN2].[Action] = '" & Dato2 & "');"
            Set rs = bd.OpenRecordset(strSQL, dbOpenDynaset)
 
            intResult = rs.RecordCount
            If intResult > 0 Then
              rs.Edit
                 rs(2).Value = Dato3
                 If Not IsNull(Dato4) And Not Dato4 = "" And Not Dato4 = "N/A" And Not Dato4 = "NA" And Not Dato4 = "TBD" And Not Dato4 = "None" Then
                 rs(3).Value = Dato4
                 End If
                 If Not IsNull(Dato5) And Not Dato5 = "" And Not Dato5 = "N/A" And Not Dato5 = "NA" And Not Dato5 = "TBD" And Not Dato5 = "None" Then
                 rs(4).Value = Dato5
                 End If
                 rs(5).Value = Dato6
              rs.Update
            Else
              rst.AddNew
                 rst(0).Value = Dato1
                 rst(1).Value = Dato2
                 rst(2).Value = Dato3
                 If Not IsNull(Dato4) And Not Dato4 = "" And Not Dato4 = "N/A" And Not Dato4 = "NA" And Not Dato4 = "TBD" And Not Dato4 = "None" Then
                    rst(3).Value = Dato4
                 End If
                 If Not IsNull(Dato5) And Not Dato5 = "" And Not Dato5 = "N/A" And Not Dato5 = "NA" And Not Dato5 = "TBD" And Not Dato5 = "None" Then
                    rst(4).Value = Dato5
                 End If
                 rst(5).Value = Dato6
              rst.Update
            End If
             i = i + 1
             Dato2 = Trim$(Obj_Hoja.Cells(77 + Contador + i, 2))
 
        Loop
 
    rs.Close
    Excel_a_AccessCCN2 = True
 
    Call Descargar_Objetos(rst, bd, Obj_Excel, Obj_Hoja)
    Screen.MousePointer = vbDefault
 
Exit Function
ErrSub:
Call Descargar_Objetos(rst, bd, Obj_Excel, Obj_Hoja)
MsgBox Err.Description, vbCritical
Screen.MousePointer = vbDefault
 
End Function
Private Function Excel_a_AccessCCN4(Path_BD As String, Path_XLS As String, La_Tabla As String) As Boolean
 Dim Obj_Excel       As Object
    Dim Obj_Hoja        As Object
    Dim bd              As DAO.Database
    Dim rst             As DAO.Recordset
 
    Dim Dato1       As String
    Dim Dato2       As String
    Dim Dato3       As Variant
    Dim Dato4       As Variant
    Dim Dato5       As Variant
    Dim Dato6       As Variant
    Dim Dato7       As Variant
    Dim i           As Integer
    Dim rs              As DAO.Recordset
    Dim intResult       As Integer
    Dim strSQL          As String
    Dim sql5 As String
    Dim sql6 As String
 
    Screen.MousePointer = vbHourglass
 
    Set Obj_Excel = CreateObject("Excel.Application")
 
    Obj_Excel.Workbooks.Open FileName:=Path_XLS
 
        Set Obj_Hoja = Obj_Excel.Sheets("CCN-TCN-CIN Form")
 
        Set bd = OpenDatabase(Path_BD)
        Set rst = bd.OpenRecordset(La_Tabla, dbOpenTable)
        i = 0
        Dato2 = Trim$(Obj_Hoja.Cells(77 + Contador * 2, 2))
        Do While Not Dato2 = vbNullString
 
            If Frame19.Value = 1 Then
                Dato1 = Trim$(Obj_Hoja.Cells(4, 4)) ' Identification #
            Else
               If Len(Text16.Value) = 1 Then
                   sequential = "00" & Text16.Value
               ElseIf Len(Text16.Value) = 2 Then
                   sequential = "0" & Text16.Value
               End If
               Dato1 = Text9.Value & "-" & Text11.Value & "-" & Format(Text13.Value, "yyyymm") & "-" & sequential
            End If
            Dato2 = Trim$(Obj_Hoja.Cells(77 + Contador * 2 + i, 2))  ' Action
            Dato3 = Trim$(Obj_Hoja.Cells(77 + Contador * 2 + i, 3))  ' Implementation date
            Dato4 = Trim$(Obj_Hoja.Cells(77 + Contador * 2 + i, 5))  ' Reasons for late implementation
            Dato5 = Trim$(Obj_Hoja.Cells(77 + Contador * 2 + i, 10))  ' Responsible person
 
 
           sql5 = "INSERT INTO CCN4 ( [Identification #], [Action], [Implementation date], [Reasons for late implementation], [Responsible person] ) SELECT '" & Dato1 & "' AS Expr1, '" & Dato2 & "' AS Expr2, '" & Dato3 & "' AS Expr3, '" & Dato4 & "' AS Expr4, '" & Dato5 & "' AS Expr5;"
            DoCmd.RunSQL sql5
 
           sql6 = "DELETE CCN4.[Identification #], CCN4.[Action] FROM CCN4 WHERE ((((CCN4.[Identification #]) Is Not Null) AND ([CCN4.Action]) Is not Null) AND (CCN4.[Implementation Date]) Is Null);"
            DoCmd.RunSQL sql6
 
            strSQL = "SELECT * FROM [CCN4] WHERE ([CCN4].[Identification #] = '" & Dato1 & "' AND [CCN4].[Action] = '" & Dato2 & "');"
            Set rs = bd.OpenRecordset(strSQL, dbOpenDynaset)
 
            intResult = rs.RecordCount
            If intResult > 0 Then
              rs.Edit
                 If Not IsNull(Dato3) And Not Dato3 = "" Then
                    rs(2).Value = Dato3
                 End If
                 rs(3).Value = Dato4
                 rs(4).Value = Dato5
              rs.Update
            Else
                rst.AddNew
                 rst(0).Value = Dato1
                 rst(1).Value = Dato2
                 If Not IsNull(Dato3) And Not Dato3 = "" Then
                    rst(2).Value = Dato3
                 End If
                 rst(3).Value = Dato4
                 rst(4).Value = Dato5
                rst.Update
            End If
             i = i + 1
             Dato2 = Trim$(Obj_Hoja.Cells(77 + Contador * 2 + i, 2))
        Loop
 
    rs.Close
    Excel_a_AccessCCN4 = True
 
    Call Descargar_Objetos(rst, bd, Obj_Excel, Obj_Hoja)
    Screen.MousePointer = vbDefault
 
Exit Function
ErrSub:
Call Descargar_Objetos(rst, bd, Obj_Excel, Obj_Hoja)
MsgBox Err.Description, vbCritical
Screen.MousePointer = vbDefault
 
 
End Function
 
Sub Descargar_Objetos(rst As Recordset, bd As Database, Obj_Excel As Object, Obj_Hoja As Object)
    Set rst = Nothing
    bd.Close
    Set bd = Nothing
    Obj_Excel.ActiveWorkbook.Close False
    Obj_Excel.Quit
    Set Obj_Hoja = Nothing
    Set Obj_Excel = Nothing
 
End Sub
 
Private Sub Command0_Click()
 
  Dim ret As Boolean, ret1 As Boolean, ret2 As Boolean, ret3 As Boolean
  Dim direccion As String
  Dim f    As Object
  Dim archivo As String
 
    direccion = CurrentProject.Path & "\DB_CCN.accdb"
 
    Set f = Application.FileDialog(3)
    f.Show
    archivo = f.SelectedItems.Item(1)
 
    'Excel_a_Access(Dirección, Archivo, Tabla)
    DoCmd.SetWarnings False
    ret = Excel_a_AccessCCN(direccion, archivo, "CCN")
    ret1 = Excel_a_AccessCCN1(direccion, archivo, "CCN1")
    ret2 = Excel_a_AccessCCN2(direccion, archivo, "CCN2")
    ret3 = Excel_a_AccessCCN3(direccion, archivo, "CCN3")
    ret4 = Excel_a_AccessCCN4(direccion, archivo, "CCN4")
 
    'If ret And ret1 And ret2 And ret3 And ret4 Then
    If ret And ret1 And ret2 And ret3 And ret4 Then
        MsgBox " Proceso Finalizado "
    End If
     DoCmd.SetWarnings True
End Sub
 
Private Sub Command18_Click()
Text16 = Val(Text16) + 1
DoCmd.SetWarnings False
DoCmd.OpenQuery "Q_UpdateSequential"
DoCmd.SetWarnings True
End Sub
Private Sub Command26_Click()
Text16 = Val(Text16) - 1
DoCmd.SetWarnings False
DoCmd.OpenQuery "Q_UpdateSequential"
DoCmd.SetWarnings True
End Sub
Private Sub Form_Load()
Command0.Caption = " Transfer CCN Excel File "
Text9 = ""
Text11 = ""
Text13 = ""
Text16 = ""
Frame19.DefaultValue = 1
End Sub
Private Sub Option22_GotFocus()
    Text9.Enabled = False
    Text11.Enabled = False
    Text13.Enabled = False
    Text16.Enabled = False
    Command18.Enabled = False
    Command26.Enabled = False
End Sub
 
Private Sub Option24_GotFocus()
    Text9.Enabled = True
    Text11.Enabled = True
    Text13.Enabled = True
    Text16.Enabled = True
    Command18.Enabled = True
    Command26.Enabled = True
End Sub
Private Sub Text11_Change()
Text16 = Text11.Column(1)
End Sub
 
Cronk

Cronk

Registered User.
Local time
Tomorrow, 03:46
Joined
Jul 4, 2013
Messages
2,771
The line
Set rst = bd.OpenRecordset(La_Tabla, dbOpenTable)
is opening up the recordset but you don't find the particular record you want to update when you later have rst.Edit

In other words, you always make the changes to the first record in rst.

You could put something like
rst.findfirst "[Identification #] = '" & Dato1 & "'"
if rst.nomatch then
rst.addnew

else
rst.edit


endif
 
A

almagana07

New member
Local time
Today, 12:46
Joined
Aug 2, 2013
Messages
4
Thanks Cronk,

I added the code you suggested as follows, however it says that "Operation is not supported for this type of object", maybe I'm placing it in the wrong place:

Code: 
Obj_Excel.Workbooks.Open FileName:=Path_XLS
    
        Set Obj_Hoja = Obj_Excel.Sheets("CCN-TCN-CIN Form")
           
        Set bd = OpenDatabase(Path_BD)
            Set rst = bd.OpenRecordset(La_Tabla, dbOpenTable)
        
        If Frame19.Value = 1 Then
            Dato1 = Trim$(Obj_Hoja.Cells(4, 4)) ' Identification #
            rst.FindFirst "[Identification #] = '" & Dato1 & "'"
            If rst.NoMatch Then
                rst.AddNew
            Else
                rst.Edit
            End If
        
        Else
            If Len(Text16.Value) = 1 Then
               sequential = "00" & Text16.Value
            ElseIf Len(Text16.Value) = 2 Then
               sequential = "0" & Text16.Value
            End If
            Dato1 = Text9.Value & "-" & Text11.Value & "-" & Format(Text13.Value, "yyyymm") & "-" & sequential
        End If
 
Cronk

Cronk

Registered User.
Local time
Tomorrow, 03:46
Joined
Jul 4, 2013
Messages
2,771
It always makes it easier if you give the line of code where the error occurs.

I suspect it is
Set bd = OpenDatabase(Path_BD)

bd is defined as a DAO object, not ADO so the syntax is not correct.

If the table is in the database, or linked to it, use
set bd = currentdb
instead of the above line.

Otherwise come back with what is in Path_BD and the full (and path) name of your database.

Let me know how it goes.
Path_BD
 
spikepl

spikepl

Eledittingent Beliped
Local time
Today, 19:46
Joined
Nov 3, 2010
Messages
6,144
dbOpenTable->dbOpenDynaset

FindFirst does not go together with dbOpenTable, which you could find out yourself by simply looking FindFirst up in the Access documentation.

As Cronk mentioned:in the future do not withhold information such as what line gave the error - that just causes a waste of time for the people who attempt to help you
 
A

almagana07

New member
Local time
Today, 12:46
Joined
Aug 2, 2013
Messages
4
Hi, thank you both. I made both changes: Changed "OpenDatabase" to "Currentdb" and "dbOpenTable" to "dbOpenDynaset", this removed the error I was getting, which btw was the in the following line:

rst.FindFirst "[Identification #] = '" & Dato1 & "'"

However, I'm still having my first record overwritten and a new record added but with no information but the Identification # in the main table CCN. Here is how it is now. Thank you lots for your help!

Code: 
Option Compare Database
Dim Contador As Integer
Dim sequential As String
Private Function Excel_a_AccessCCN(Path_BD As String, Path_XLS As String, La_Tabla As String) As Boolean
    Dim Obj_Excel       As Object
    Dim Obj_Hoja        As Object
    Dim bd              As DAO.Database
    Dim rst             As DAO.Recordset
    Dim rs              As DAO.Recordset
    Dim intResult       As Integer
    Dim strSQL          As String
    
    Dim Dato1      As String
    Dim Dato2      As Variant
    Dim Dato3      As Variant
    Dim Dato4      As Variant
    Dim Dato5      As Variant
    Dim Dato6      As Variant
    Dim Dato7      As Variant
    Dim Dato8      As Variant
    Dim Dato9      As Variant
    Dim Dato10     As Variant
    Dim Dato11     As Variant
    Dim Dato12     As Variant
    Dim Dato13     As Variant
    
    Dim SQL2 As String
  
    Screen.MousePointer = vbHourglass
  
    Set Obj_Excel = CreateObject("Excel.Application")
  
    Obj_Excel.Workbooks.Open FileName:=Path_XLS
    
        Set Obj_Hoja = Obj_Excel.Sheets("CCN-TCN-CIN Form")
           
        Set bd = CurrentDb
            Set rst = bd.OpenRecordset(La_Tabla, dbOpenDynaset)
        
        If Frame19.Value = 1 Then
            Dato1 = Trim$(Obj_Hoja.Cells(4, 4)) ' Identification #
            rst.FindFirst "[Identification #] = '" & Dato1 & "'"
            If rst.NoMatch Then
                rst.AddNew
            Else
                rst.Edit
            End If
        
        Else
            If Len(Text16.Value) = 1 Then
               sequential = "00" & Text16.Value
            ElseIf Len(Text16.Value) = 2 Then
               sequential = "0" & Text16.Value
            End If
            Dato1 = Text9.Value & "-" & Text11.Value & "-" & Format(Text13.Value, "yyyymm") & "-" & sequential
        End If
        
       SQL1 = "INSERT INTO CCN ( [Identification #] ) SELECT '" & Dato1 & "' AS Expr1"
    DoCmd.RunSQL SQL1
        
        Dato2 = Trim$(Obj_Hoja.Cells(6, 4)) ' Type of notice
        Dato3 = Trim$(Obj_Hoja.Cells(8, 4)) ' Region
        Dato4 = Trim$(Obj_Hoja.Cells(50, 4)) ' Risk Level
        Dato5 = Trim$(Obj_Hoja.Cells(65, 4)) ' Affected Areas
        Dato6 = Trim$(Obj_Hoja.Cells(6, 7)) ' CCN/TCN/CIN Date
        Dato7 = Trim$(Obj_Hoja.Cells(8, 7)) ' Publication Date
        Dato8 = Trim$(Obj_Hoja.Cells(50, 7)) ' Effective Date
        Dato9 = Trim$(Obj_Hoja.Cells(65, 7)) ' Response Due Date
        Dato10 = Trim$(Obj_Hoja.Cells(8, 10)) ' Prepared By
        Dato11 = Trim$(Obj_Hoja.Cells(50, 10)) ' Reviewed By
        Dato12 = Trim$(Obj_Hoja.Cells(69, 2)) ' Reference
        Dato13 = Trim$(Obj_Hoja.Cells(73, 2)) ' Description of Change
        
        
        SQL2 = "INSERT INTO CCN ( [Identification #], [Type of notice], [Region], [Risk Level], [Affected Areas], [CCN/TCN/CIN Date], [Publication Date], [Effective Date], [Response Due Date], [Prepared by], [Reviewed], [Reference], [Description of change] ) SELECT '" & Dato1 & "' AS Expr1, '" & Dato2 & "'AS Expr2, '" & Dato3 & "' AS Expr3, '" & Dato4 & "' AS Expr4, '" & Dato5 & "' AS Expr5, '" & Dato6 & "' AS Expr6, '" & Dato7 & "' AS Expr7, '" & Dato8 & "' AS Expr8, '" & Dato9 & "' AS Expr9, '" & Dato10 & "' AS Expr10, '" & Dato11 & "' AS Expr11, '" & Dato12 & "' AS Expr12, '" & Dato13 & "' AS Expr13;"
           DoCmd.RunSQL SQL2
        
        
        
        strSQL = "SELECT Count([CCN].[Identification #]) as RecordCount FROM [CCN] WHERE ([CCN].[Identification #] = '" & Dato1 & "');"
        Set rs = bd.OpenRecordset(strSQL, dbOpenSnapshot)
        
        intResult = rs("RecordCount")
        If intResult > 0 Then
            rst.Edit
                rst(1).Value = Dato2
                rst(2).Value = Dato3
                rst(3).Value = Dato4
                rst(4).Value = Dato5
                rst(5).Value = Dato6
                If Not IsNull(Dato7) And Not Dato7 = "" And Not Dato7 = "N/A" And Not Dato7 = "NA" And Not Dato7 = "TBD" And Not Dato7 = "None" Then
                    rst(6).Value = Dato7
                End If
                If Not IsNull(Dato8) And Not Dato8 = "" And Not Dato8 = "N/A" And Not Dato8 = "NA" And Not Dato8 = "TBD" And Not Dato8 = "None" Then
                    rst(7).Value = Dato8
                End If
                If Not IsNull(Dato9) And Not Dato9 = "" And Not Dato9 = "N/A" And Not Dato9 = "NA" And Not Dato9 = "TBD" And Not Dato9 = "None" Then
                    rst(8).Value = Dato9
                End If
                rst(9).Value = Dato10
                rst(10).Value = Dato11
                rst(11).Value = Dato12
                rst(12).Value = Dato13
            rst.Update
        Else
            rst.AddNew
                rst(0).Value = Dato1
                rst(1).Value = Dato2
                rst(2).Value = Dato3
                rst(3).Value = Dato4
                rst(4).Value = Dato5
                rst(5).Value = Dato6
                If Not IsNull(Dato7) And Not Dato7 = "" And Not Dato7 = "N/A" And Not Dato7 = "NA" And Not Dato7 = "TBD" And Not Dato7 = "None" Then
                    rst(6).Value = Dato7
                End If
                If Not IsNull(Dato8) And Not Dato8 = "" And Not Dato8 = "N/A" And Not Dato8 = "NA" And Not Dato8 = "TBD" And Not Dato8 = "None" Then
                    rst(7).Value = Dato8
                End If
                If Not IsNull(Dato9) And Not Dato9 = "" And Not Dato9 = "N/A" And Not Dato9 = "NA" And Not Dato9 = "TBD" And Not Dato9 = "None" Then
                    rst(8).Value = Dato9
                End If
                rst(9).Value = Dato10
                rst(10).Value = Dato11
                rst(11).Value = Dato12
                rst(12).Value = Dato13
            rst.Update
        End If
        
    rs.Close
    Excel_a_AccessCCN = True
       
    Call Descargar_Objetos(rst, bd, Obj_Excel, Obj_Hoja)
    Screen.MousePointer = vbDefault
  
Exit Function
ErrSub:
Call Descargar_Objetos(rst, bd, Obj_Excel, Obj_Hoja)
MsgBox Err.Description, vbCritical
Screen.MousePointer = vbDefault
       
End Function
 
Cronk

Cronk

Registered User.
Local time
Tomorrow, 03:46
Joined
Jul 4, 2013
Messages
2,771
Have you traced your code's operation to find out where it is not doing what you want.

That is, put your cursor on the line
If Frame19.Value = 1 Then
and press function key F9.

That will put a break point on that line. Cause the code to execute and stop on that line. You can then step through your code line at a time by pressing function key F8

You can examine the value of any variable by typing for example
? Dato1
or
? rst![Identification #]
in the Immediate Window (press Ctrl + G) to display if it is not already shown.

In any case, I don't see any looping so unless your spreadsheet is being updated, you will always be carrying out the operation once on the same record.
 
You must log in or register to reply here.

Similar threads

A
Solved Retrieve value and not primary key from Data Access Objects (DAO)
Replies
3
Views
628
Ashisht76
A
G
How to fill Listbox with data from another workbook
Replies
3
Views
556
goncalo
G
W
CSV or XLSX Bank Statement to Access module (need to import via VBA and then write back to Excel with imported flag)
Replies
14
Views
1,025
Cotswold
Cotswold
L
Export data from Access to Word with VBA
Replies
12
Views
966
arnelgp
arnelgp
J
Solved Insert xml data from responsetext to table in access with VBA
Replies
14
Views
1,354
john_gringo
J

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom