PDA

View Full Version : extract data from a closed workbook



khalid79m
11-05-2008, 04:58 AM
Option Explicit
Private Sub GatherStage1SITE()
Windows("Control.xls").Activate
Sheets("SITE").Select
If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
With Range("A3:IV65536")
.ClearContents
End With
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim i As Integer, wb As Workbook

With Application.FileSearch
.NewSearch
.LookIn = "\\ukta03\transfer\Monitoring\ (file://\\ukhbeudata03\transfer\Monitoring\)"
.SearchSubFolders = True
.Filename = "*.xls"
.Application.DisplayAlerts = False
.Execute
For i = 1 To .FoundFiles.Count

Set wb = Workbooks.Open(Filename:=.FoundFiles(i), ReadOnly:=True)
Run "GatherStage2SITE"

wb.Close savechanges:=False

Next i
End With
Application.EnableEvents = True
Application.ScreenUpdating = True


End Sub

Private Sub GatherStage2SITE()

Sheets("Submitted_Calls").Select

If Range("A3") <> "" Then

Dim lastrow As Long
Application.ScreenUpdating = False
lastrow = Cells(Rows.Count, "A").End(xlUp).Row

With Range("A3:IV" & lastrow)
.Copy
End With
Windows("Control.xls").Activate

Sheets("SITE").Select
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
End If
End Sub


I currently have the above code it opens each file looks at the Submitted_Calls sheets, sees if there is any value a3, if there is it copys all data from a3 to lastrow of that sheet, the only problem here is these files are now massive and each file one and close takes forever :( an update which took 9 miutes before now takes and 1 hour, is there any better way of doing thuis

Bob Phillips
11-05-2008, 05:41 AM
I think you will striuggle, as you are grabbing a variable number of rows from the workbook.s

khalid79m
11-05-2008, 05:59 AM
what if grabed everything from rom a3:iv1000 ?

khalid79m
11-05-2008, 07:26 AM
Can any one help.. the aim is to get all the data from the sheets onto one.

Dr.K
11-05-2008, 08:05 AM
Yes, ADO and SQL are a good anwser... give me a minute and I will dig up the code for you.


EDIT:

Here is a function that opens an ADO Connection to a specific Excel worksheet:
Private Function GetExcelConn(Path As String, _
Optional ReadOnly As Boolean = True, _
Optional Headers As Boolean = True) As Object


Dim strConn As String

Set GetExcelConn = New ADODB.Connection

strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & Path & ";" _
& "Extended Properties=""Excel 8.0;" _
& "ReadOnly=" & ReadOnly & ";" _
& "HDR=" & IIf(Headers, "Yes", "No") & ";"""

GetExcelConn.Open strConn

End Function

Once you've got the connection open, you can use standard SQL to get back Recordsets, like this:

strSQL = "SELECT * FROM [SheetName$]"

strSQL = "SELECT * FROM [SheetName$] WHERE [Field Name] LIKE 'A%'"

strSQL = "SELECT * FROM [SheetName$] WHERE [Field Name] LIKE 'A%' ORDER BY [Field Name]"


Set rstXL = New ADODB.Recordset

rstXL.Open strSQL, conXL, adOpenForwardOnly, adLockReadOnly, adCmdText

NOTE: if your data has no headers, the Field Names returned are 'F1', 'F2', etc. etc.

NOTE: Jet treats blank (empty) Excel Cells as NULL values, so if you are using SQL, you may need to set an extra condition(s) in your WHERE clause for ' AND NOT [FieldName] IS NULL'. ('Nz' and 'Coalesce' do NOT work in Jet)

Or, if you just want to pull a Range of Cells in, you can use the Execute Method like this:


Set rstXL = New ADODB.Recordset

Set rstXL = conXL.Execute("[A1:A2]")
'First Worksheet only

Set rstXL = conXL.Execute("[DefinedRangeName]")
'A defined name from ANY Worksheet

More reference:
http://support.microsoft.com/kb/257819

khalid79m
11-06-2008, 04:23 AM
<<<<<<<<<<< confused.com >>>>>>>>>

thanks for all your help mate, im new to SQL.... :dunno what is ado ? is there anywhere I can get basic training ??

Bob Phillips
11-06-2008, 04:34 AM
ActiveX Data Objects (ADO) is Microsoft's data access layer. It's objective is to provide a single, consistent interface into various datastores, nit ust databases such as SQL-Server, Access, but also text such as Excel, text files, CSV, and things such as Active Directory.

Each different target data source requires a (potentially) different driver, which you identify in the connection string.

khalid79m
11-06-2008, 05:25 AM
: pray2: do u think it possible for me to achieve what i require through activex? if yes do you have any resources that can help me achieve my goal.

Bob Phillips
11-06-2008, 06:17 AM
That is exactly what Dr. K suggested, ADO and SQL.

khalid79m
11-06-2008, 10:13 AM
How do I use the function , ive never done this before,,

Dr.K
11-10-2008, 11:26 AM
Wow dude, you need to try a little harder on your own. That page I linked to contains all the info you need.

Ok, here is a generic example that pulls two cells from a bunch of workbooks:

Sub GenericDataPuller()

Dim CurFile As String

Dim rstXL As Object
Dim conXL As Object


Set rstXL = New ADODB.Recordset
Set conXL = New ADODB.Connection


Let CurFile = Dir(constFilePath & "*.xls")

'loop through every XLS file in the source directory
Do While Not CurFile = Empty

Set conXL = GetExcelConn(constFilePath & CurFile, True, False)

Set rstXL = conXL.Execute("[A1:A2]")


'***Add code here to do something with the data***

'close the objects
rstXL.Close
conXL.Close
Set conXL = Nothing

Let CurFile = Dir ' Get next entry

Loop

Set rstXL = Nothing
Set conXL = Nothing


End Sub

khalid79m
11-12-2008, 05:47 AM
what does this bit of the code do ?

Set rstXL = conXL.Execute("[A1:A2]")

Bob Phillips
11-12-2008, 06:19 AM
Takes the values from cells A1 & A2 from the workbook currently connected to and drops them into a recordset.

Krishna Kumar
11-12-2008, 07:23 AM
Hi,

See more info here (http://www.rondebruin.nl/ado.htm)

khalid79m
11-12-2008, 07:56 AM
I have managed to get the code to do what I want but how do I point to a folder location ? I am new to this so bear with me :help

Bob Phillips
11-12-2008, 07:57 AM
Look at FileDialog in VBA help.

khalid79m
11-12-2008, 08:36 AM
still struggling, the path is c:/pat/ins/ff/

and i need to look into sub folders as well

khalid79m
11-12-2008, 09:19 AM
Sub GenericDataPuller()

Dim CurFile As String

Dim rstXL As Object
Dim conXL As Object


Set rstXL = New ADODB.Recordset
Set conXL = New ADODB.Connection


Let CurFile = Dir(constFilePath & "c:/pat/ins/ff/*.xls")

'LOOP EVERYTHING IN THE SOURCE DIRECTORY
Do While Not CurFile = Empty

Set conXL = GetExcelConn(constFilePath & CurFile, True, False)

Set rstXL = conXL.Execute("[I3:CG20]")


'***Add code here to do something with the data***

'close the objects
rstXL.Close
conXL.Close
Set conXL = Nothing

Let CurFile = Dir ' Get next entry

Loop

Set rstXL = Nothing
Set conXL = Nothing


End Sub

khalid79m
11-12-2008, 09:51 AM
i read so many tutorials .. i give up :( seems to hard for me to grasp brain is frazzeld, houston im out.. thanks guys for all you help