PDA

View Full Version : RecordSet in Excel VBA



waqas
07-15-2015, 07:45 PM
Dear All,

thanks for all to cooperate as usual.

now i have two workbooks one open and one is closed. i want to make recordset from close workbook and find record one by one in open workbook if it found then update something.

how i have to do it please guide me.:think:

waqas
07-15-2015, 09:01 PM
This is my code and i am getting error.

Sub Read_External_Workbook_Verify()
Dim Target_Path, ActiveWb1 As String, ActiveWb2 As String
Dim ExclConn As ADODB.Connection, ExclRec As ADODB.Recordset, DataRec As ADODB.Recordset, FindRec As String
Dim ListTbl As Range, val, r As Range, FullRng As Range, DataStr As String, DataConn As ADODB.Connection


Set FullRng = Sheets("Data").Range("A1").CurrentRegion
'Application.ScreenUpdating = False


ChDrive "D:\"
ChDir "D:\Users\" & Environ("UserName") & "\Desktop"
Target_Path = Application.GetOpenFilename(Title:="Please Choose a File To Import", Filefilter:="Excel Files *.xls(*.xls),")


'**************************************
Set ExclConn = New ADODB.Connection
Set ExclRec = New ADODB.Recordset
StrExcel = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & Target_Path & _
";Extended Properties=""Excel 12.0 XML; mACRO; HDR=Yes;"""

ExclConn.ConnectionString = StrExcel
ExclConn.Open


'*************************************** Load Workbook Data

With ExclRec
.ActiveConnection = ExclConn
.Source = "Select * from [Sheet0$];"
.LockType = adLockReadOnly
.CursorType = adOpenKeyset
.Open
'Debug.Print .RecordCount
Do Until .EOF
FindRec = LTrim(.Fields(3).Value)
'***********************************************************Open Workbook Data
Set DataConn = New ADODB.Connection
Set DataRec = New ADODB.Recordset
DataStr = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 12.0 XML; mACRO; HDR=Yes;"""

DataConn.ConnectionString = DataStr
DataConn.Open
With DataRec
.ActiveConnection = DataConn
.Source = "Select * from [Data$];"
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
.Open

'Debug.Print .RecordCount
'.Find FindRec
Do Until .EOF
.Find "UACU5346375"
'************************* After Find i want to update
.MoveNext
Loop


End With
DataRec.Close
DataConn.Close

Set DataRec = Nothing
Set DataConn = Nothing
'***********************************************************
.MoveNext
Loop
End With
ExclRec.Close
ExclConn.Close

Set ExclRec = Nothing
Set ExclConn = Nothing
'******************************


End Sub

Kenneth Hobs
07-16-2015, 09:22 AM
Please use encapsulate code in code tags. Click the # icon to insert the tags.

What is the error? You can press F8 to execute one line at a time to see if it is not evident during a normal Run.

You have a sheet with a code name of Sheet0$?

Since you are using early binding, I assume that your ADO object was set?