S
sal21
Please make your test with my MDB
Private Sub IMPORT_ACCES()
On Error GoTo ErrHandler
Dim Rg As Range
Set Rg = ThisWorkbook.Worksheets(1).Range("a7")
'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 = ("\\GCD01F4500\DATI\PUBBLICA\BOUASS\PROVA.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 DATA_CONT, DIP, COD_BATCH, C/C, NOMINATIVO, CAUS
DARE, AVERE, VAL, SPORT_MIT, ANOM, DESCR, CRO, ABI, CAB, PAG_IMP
NR_ASS, MT, SERVIZIO, NOTE_BOU, SPESE, DATA_ATT, COD, NOTA_LIB " & _
"FROM TOTALE ORDER BY NR_ASS"
'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 Su
Private Sub IMPORT_ACCES()
On Error GoTo ErrHandler
Dim Rg As Range
Set Rg = ThisWorkbook.Worksheets(1).Range("a7")
'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 = ("\\GCD01F4500\DATI\PUBBLICA\BOUASS\PROVA.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 DATA_CONT, DIP, COD_BATCH, C/C, NOMINATIVO, CAUS
DARE, AVERE, VAL, SPORT_MIT, ANOM, DESCR, CRO, ABI, CAB, PAG_IMP
NR_ASS, MT, SERVIZIO, NOTE_BOU, SPESE, DATA_ATT, COD, NOTA_LIB " & _
"FROM TOTALE ORDER BY NR_ASS"
'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 Su