i have modified this script:
http://www.exceltip.com/show_tip/Imp...Excel/425.html
in:

Code
-------------------
Sub ADO_TOTALE()
' 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 "TOTALE", 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, "SERVIZIO", Range("S" & r).Text) Then
rs.AddNew ' create a new record
'End If
With rs
'add values to each field in the record
Sheets("L0785_TOTALE").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
.Fields("SERVIZIO") = Range("S" & r).Value
.Fields("NOTE_BOU") = Range("T" & r).Value
.Fields("SPESE") = Range("U" & r).Value
.Fields("DATA_ATT") = Range("V" & r).Value
.Fields("COD") = Range("W" & r).Value
.Fields("NOTA_LIB") = Range("X" & 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
-------------------


All is ok!

I would want the same result in the reverse mode...
Import access into excel... and controll the duplicate...

--
sal2

-----------------------------------------------------------------------
sal21's Profile: http://www.excelforum.com/member.php...nfo&userid=204
View this thread: http://www.excelforum.com/showthread.php?threadid=27608

Hi Sal

Try the following it returns a recordset from a Northwind DB.


Private Sub CommandButton1_Click()

On Error GoTo ErrHandler

Dim Rg As Range
Set Rg = ThisWorkbook.Worksheets(1).Range("a1")

'To use ADO objects in an application add a reference
'to the ADO component. From the VBA window select
'Tools/References< check the box
' "Microsoft ActiveX Data Objects 2.x Library"

'You should fully quality the path to your file

Dim DB_Name As String
DB_Name = ("C:\Program Files\Microsoft Visual Studio\VB98\NWind.mdb")
Dim DB_CONNECT_STRING As String

DB_CONNECT_STRING = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"data Source=" & DB_Name & ";" & ", , , adConnectAsync;"

'Create the connection
Dim Cnn As New ADODB.Connection
Set Cnn = New Connection
Cnn.Open DB_CONNECT_STRING

'Create the recordset
Dim rs As ADODB.Recordset
Set rs = New Recordset

'Determines what records to show
Dim strSQL As String
strSQL = "SELECT CompanyName, ContactName, City, Country " & _
"FROM Customers ORDER BY CompanyName"

'Retreive the records
rs.CursorLocation = adUseClient
rs.Open strSQL, Cnn, adOpenStatic, adLockBatchOptimistic

'Test to see if we are connected and have records
Dim num As Integer
num = rs.RecordCount

If Cnn.State = adStateOpen Then
MsgBox "Welcome to! " & DB_Name & " Records = " & num,
vbInformation, _
"Good Luck TK"
Else
MsgBox "Sorry. No Data today."
End If

'Copy recordset to the range
rs.MoveLast
rs.MoveFirst
Rg.CopyFromRecordset rs
Rg.CurrentRegion.Columns.AutoFit

'close connection
Cnn.Close
Set Cnn = Nothing
Set rs = Nothing

Exit Sub

ErrHandler:
MsgBox "Sorry, an error occured. " & Err.Description, vbOKOnly
End Sub


Good Luck
TK

"sal21" wrote:


i have modified this script:
http://www.exceltip.com/show_tip/Imp...Excel/425.html
in:

Code:
--------------------
Sub ADO_TOTALE()
' 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 "TOTALE", 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, "SERVIZIO", Range("S" & r).Text) Then
rs.AddNew ' create a new record
'End If
With rs
'add values to each field in the record
Sheets("L0785_TOTALE").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
.Fields("SERVIZIO") = Range("S" & r).Value
.Fields("NOTE_BOU") = Range("T" & r).Value
.Fields("SPESE") = Range("U" & r).Value
.Fields("DATA_ATT") = Range("V" & r).Value
.Fields("COD") = Range("W" & r).Value
.Fields("NOTA_LIB") = Range("X" & 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
--------------------


All is ok!

I would want the same result in the reverse mode...
Import access into excel... and controll the duplicate....


--
sal21


------------------------------------------------------------------------
sal21's Profile: http://www.excelforum.com/member.php...fo&userid=2040
View this thread: http://www.excelforum.com/showthread...hreadid=276085