extract data from a closed workbook

[khalid79m]

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\"
                .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]

I think you will striuggle, as you are grabbing a variable number of rows from the workbook.s

[khalid79m]

what if grabed everything from rom a3:iv1000 ?

[khalid79m]

Can any one help.. the aim is to get all the data from the sheets onto one.

[Dr.K]

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:
[VBA]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[/VBA]

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

[VBA]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[/VBA]

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:

[VBA]
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[/VBA]

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

[khalid79m]

<<<<<<<<<<< confused.com >>>>>>>>>

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

[Bob Phillips]

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]

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]

That is exactly what Dr. K suggested, ADO and SQL.

[khalid79m]

How do I use the function , ive never done this before,,

[Dr.K]

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:

[VBA]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[/VBA]

[khalid79m]

what does this bit of the code do ?

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

[Bob Phillips]

Takes the values from cells A1 & A2 from the workbook currently connected to and drops them into a recordset.

[Krishna Kumar]

Hi,

See more info here

[khalid79m]

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

[Bob Phillips]

Look at FileDialog in VBA help.

[khalid79m]

still struggling, the path is c:/pat/ins/ff/

and i need to look into sub folders as well

[khalid79m]

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]

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