S
sal21
I export a sheet of excel into table (PAGATI) with this cript
i have make a controll on a duplicate in column M of excel and in field
CRO of access table. If i re-import the macro not consider the
duplicate...
Is corect thi sscript... Please test for me.
Naturally if you have another way to controll duplicate during the
import is welcome (set your path)
:
Sub ADO_PAGATI()
' exports data from the active worksheet to a table in an Access
database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
Dim rsFind As ADODB.Recordset
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data
Source=\\GCD01F4500\DATI\PUBBLICA\BOUASS\PROVA.MDB;"
' "Data Source=D:\PROVA\PROVA.MDB;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "PAGATI", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
r = 7 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
If Not AlreadyExists(rs, "CRO", Range("M" & r).Text) Then
rs.AddNew ' create a new record
'End If
With rs
'add values to each field in the record
Sheets("L0785_PAGATI").Select
Fields("DATA_CONT") = Range("A" & r).Value
Fields("DIP") = Range("B" & r).Value
Fields("COD_BATCH") = Range("C" & r).Value
Fields("C_C") = Range("D" & r).Value
Fields("NOMINATIVO") = Range("E" & r).Value
Fields("CAUS") = Range("F" & r).Value
Fields("DARE") = Range("G" & r).Value
Fields("AVERE") = Range("H" & r).Value
Fields("VAL") = Range("I" & r).Value
Fields("SPORT_MIT") = Range("J" & r).Value
Fields("ANOM") = Range("K" & r).Value
Fields("DESCR") = Range("L" & r).Value
Fields("CRO") = Range("M" & r).Value
Fields("ABI") = Range("N" & r).Value
Fields("CAB") = Range("O" & r).Value
Fields("PAG_IMP") = Range("P" & r).Value
Fields("NR_ASS") = Range("Q" & r).Value
Fields("MT") = Range("R" & r).Value
Update ' stores the new record
End With
End If
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Public Function AlreadyExists(rstTemp As ADODB.Recordset, _
strField As String, strFilter As String) As Boolean
' Set a filter on the specified Recordset object
rstTemp.Filter = strField & " = '" & strFilter & "'"
If rstTemp.RecordCount > 0 Then AlreadyExists = True
rstTemp.Filter = ""
End Function
+-------------------------------------------------------------------+
|Filename: PROVA.zip |
|Download: http://www.excelforum.com/attachment.php?postid=2769 |
+-------------------------------------------------------------------+
i have make a controll on a duplicate in column M of excel and in field
CRO of access table. If i re-import the macro not consider the
duplicate...
Is corect thi sscript... Please test for me.
Naturally if you have another way to controll duplicate during the
import is welcome (set your path)
:
Sub ADO_PAGATI()
' exports data from the active worksheet to a table in an Access
database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
Dim rsFind As ADODB.Recordset
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data
Source=\\GCD01F4500\DATI\PUBBLICA\BOUASS\PROVA.MDB;"
' "Data Source=D:\PROVA\PROVA.MDB;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "PAGATI", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
r = 7 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
If Not AlreadyExists(rs, "CRO", Range("M" & r).Text) Then
rs.AddNew ' create a new record
'End If
With rs
'add values to each field in the record
Sheets("L0785_PAGATI").Select
Fields("DATA_CONT") = Range("A" & r).Value
Fields("DIP") = Range("B" & r).Value
Fields("COD_BATCH") = Range("C" & r).Value
Fields("C_C") = Range("D" & r).Value
Fields("NOMINATIVO") = Range("E" & r).Value
Fields("CAUS") = Range("F" & r).Value
Fields("DARE") = Range("G" & r).Value
Fields("AVERE") = Range("H" & r).Value
Fields("VAL") = Range("I" & r).Value
Fields("SPORT_MIT") = Range("J" & r).Value
Fields("ANOM") = Range("K" & r).Value
Fields("DESCR") = Range("L" & r).Value
Fields("CRO") = Range("M" & r).Value
Fields("ABI") = Range("N" & r).Value
Fields("CAB") = Range("O" & r).Value
Fields("PAG_IMP") = Range("P" & r).Value
Fields("NR_ASS") = Range("Q" & r).Value
Fields("MT") = Range("R" & r).Value
Update ' stores the new record
End With
End If
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Public Function AlreadyExists(rstTemp As ADODB.Recordset, _
strField As String, strFilter As String) As Boolean
' Set a filter on the specified Recordset object
rstTemp.Filter = strField & " = '" & strFilter & "'"
If rstTemp.RecordCount > 0 Then AlreadyExists = True
rstTemp.Filter = ""
End Function
+-------------------------------------------------------------------+
|Filename: PROVA.zip |
|Download: http://www.excelforum.com/attachment.php?postid=2769 |
+-------------------------------------------------------------------+