PDA

View Full Version : Import closed workbook - there are lots of methods but which is best?



theta
01-31-2012, 07:21 AM
Hi all...

I receive a regular report called "DATA EXPORT.xls"

I need the entire used range of this sheet to be imported into a sheet in ThisWorkbook into a sheet called "IMPORT"

The IMPORT tab should be cleared and then the new data imported.

I have seen some methods where the UsedRange of the closed workbook is imported.

I quite like the IDEA of using ADO (like on Ron De Bruin's) website as it seems to be a very clean method, no opening of files and copying contents etc.

I would like some simple, elegant solutions to this please as I am stuck :( not sure what the best method is that is should use. The data will be updated every day...

mdmack sure you will be along at some point, your codes are always very robust and clean :)

Norie
02-01-2012, 03:47 AM
How about simply opening the workbook with the data and copying it?

All of which can be done with simple code and with the minimum fuss.

Sub GetImportData()
Dim wbData As Workbook
Dim wsDst As Worksheet
Dim wsSrc As Worksheet

Application.ScreenUpdating = False

Set wsDst = ThisWorkbook.Worksheets("IMPORT")
wsDst.Cells.ClearContents
Set wbData = Workbooks.Open("C:\DATA EXPORT.XLS") ' change C:\ to required path
wbData.Worksheets(1).UsedRange.Copy
wsDst.Range("A1")
wbData.Close False

Application.ScreenUpdating = False
End Sub

theta
02-01-2012, 04:01 AM
How would I tweak this to be more specific. Instead of the UsedRange, could I say only where :

Column 1 = "ABC1" and Column 2 => "17"

Thought could define the start and end rows, then cycle through all rows until the last row in the usedrange is reached. Each time both condition are true, the row is copied to current workbook next blank row. If the condition is false, the loop continues?

Norie
02-01-2012, 04:21 AM
Do you know the sheet and column/field names?

If you do then ADO could be used.

Otherwise I think the other workbook would definitely need to be opened and then perhaps a filter could be used to get the data you want.

Or you could use the code I posted, and then do a filter.

theta
02-01-2012, 04:29 AM
I know the field names. The column header is "CUSTOMER" and the other column header is "DATE"

How would I acheive this with ADO? Do you have an example? :)

theta
02-01-2012, 04:34 AM
I have been looking at Ron De Bruin's ADO example but the SQL statement is just "SELECT *"

You have to manually define the range to be imported (unless this could become UsedRange) and then a true SQL statement could be used to analyse the fields? (and how would the fields be defined?)

Ron's code


Option Explicit

Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
' 30-Dec-2007, working in Excel 2000-2007
Dim rsCon As Object
Dim rsData As Object
Dim szConnect As String
Dim szSQL As String
Dim lCount As Long
' Create the connection string.
If Header = False Then
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"";"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=No"";"
End If
Else
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
End If
End If
If SourceSheet = "" Then
' workbook level name
szSQL = "SELECT * FROM " & SourceRange$ & ";"
Else
' worksheet level name or range
szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
End If
On Error GoTo SomethingWrong
Set rsCon = CreateObject("ADODB.Connection")
Set rsData = CreateObject("ADODB.Recordset")
rsCon.Open szConnect
rsData.Open szSQL, rsCon, 0, 1, 1
' Check to make sure we received data and copy the data
If Not rsData.EOF Then
If Header = False Then
TargetRange.Cells(1, 1).CopyFromRecordset rsData
Else
'Add the header cell in each column if the last argument is True
If UseHeaderRow Then
For lCount = 0 To rsData.Fields.Count - 1
TargetRange.Cells(1, 1 + lCount).Value = _
rsData.Fields(lCount).Name
Next lCount
TargetRange.Cells(2, 1).CopyFromRecordset rsData
Else
TargetRange.Cells(1, 1).CopyFromRecordset rsData
End If
End If
Else
MsgBox "No records returned from : " & SourceFile, vbCritical
End If
' Clean up our Recordset object.
rsData.Close
Set rsData = Nothing
rsCon.Close
Set rsCon = Nothing
Exit Sub
SomethingWrong:
MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
vbExclamation, "Error"
On Error GoTo 0
End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Function Array_Sort(ArrayList As Variant) As Variant
Dim aCnt As Integer, bCnt As Integer
Dim tempStr As String
For aCnt = LBound(ArrayList) To UBound(ArrayList) - 1
For bCnt = aCnt + 1 To UBound(ArrayList)
If ArrayList(aCnt) > ArrayList(bCnt) Then
tempStr = ArrayList(bCnt)
ArrayList(bCnt) = ArrayList(aCnt)
ArrayList(aCnt) = tempStr
End If
Next bCnt
Next aCnt
Array_Sort = ArrayList
End Function


Example to run the above (you have to define range)


' With the example below you can select one file with GetOpenFilenamewhere
Sub GetData_Example4()
Dim SaveDriveDir As String, MyPath As String
Dim FName As Variant
SaveDriveDir = CurDir
MyPath = Application.DefaultFilePath 'or use "C:\Data"
ChDirNet MyPath
ChDir MyPath
FName = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*")
If FName = False Then
'do nothing
Else
GetData FName, "Sheet1", "A5:X4715", Sheets("Sheet1").Range("A1"), False, False
End If
ChDirNet SaveDriveDir
ChDir SaveDriveDir
End Sub

Norie
02-01-2012, 04:53 AM
theta

If you don't create a named range you can't use that code, and UsedRange can't be used instead.

Do you know the worksheet name?

If you know that and the field names the ADO would be pretty straightforward.

It can be done without the sheet name but it might be a bit more complicated.

By the way, if the second column is a date how does the criteria =>"17" work?

I was just about to start on an example when I noticed that.:)

theta
02-01-2012, 05:21 AM
ADO would be great, as then I can access the file using pure SQL. The file is automatically generated by our system onto "Sheet1" but there are no named ranges etc :(

Please find a sample here. And you were correct about the date :)

The fields are called "Client" and "Date". The format of the report will not change so can be used 'as is'. Amounts and notes have been deleted for sample purposes.

So an example would be import Client = "DEUE2" and Date => "01/01/2008" (ignoring the seconds). Or to get really fancy include something where Field "Hard Copy Reference" is LIKE "*_GSM"

Any help would be amazing :)

http://www.mediafire.com/?am1hd6cn45b8n5b

Norie
02-01-2012, 05:33 AM
I can import the data using ADO but there's a problem - the field names starts on row 2.

So they come out as 'IOT CREDIT NOTE REPORT', '01-Feb-2012', F3, F4, F5 etc. - the first 2 seem to be the name of the report and a date stamp.

I could just use those as the field names in the criteria but what if they change?

theta
02-01-2012, 06:22 AM
Hmmm. is there any way in ADO to define ROW 2 as the header row? Or at the start of the macro delete the first row/record (I do not need this info)

Many thanks again...

theta
02-01-2012, 08:40 AM
And to confirm the '01-Feb-2012' would change as it is dynamic from the report generation tool (an Oracle business objects exporter).

Is there a way for SQL to define which row is to be used for header?

Or import using SELECT * then remove the top record and make the second record headers, then run the SQL for the import (up to this point everything would be a recordset and not on the sheet?)

I am not sure but your suggestions so far have been spot on

Norie
02-01-2012, 09:08 AM
theta

I don't think any of that's possible apart from opening the worksheet and deleting the problem row(s).

Which kind of defeats the point of not opening the workbook.

It think it might be possible to filter the recordset, I'll give it a try.

theta
02-01-2012, 09:15 AM
That will be amazing!

I have no problem in having a pre-import macro to remove the two problem rows, then import the records as recordset using the SQL.

The workbook can be opened - but dont want any information copied into the current workbook that doesnt meet criteria (as it will be highly sensitive). And like the flexibility that ADO would offer - if I could learn this approach will have alot of useful approaches :)

Norie
02-01-2012, 09:15 AM
Right, I've managed it using the criteria ARGTM for the first field.

If you can supply some criteria for the other fields that will definitely return records I can test further.

Here's the code anyway.



Option Explicit


Sub DataFromClosedWB()
Dim wsDst As Worksheet
Dim rngDst As
Range
Dim cn As Object ' ADODB.Connection
Dim rsData As
ADODB.Recordset
Dim rsSchema As Object
Dim fld As Object
Dim strCon As
String
Dim strFileName As String
Dim strShName As String
Dim strSQL As
String
Dim I As Long
Const adSchemaTables = 20


Set wsDst = ThisWorkbook.Worksheets("IMPORT")


wsDst.Cells.ClearContents


Set rngDst = wsDst.Range("A1")

strFileName = "C:\REPORT SAMPLE.xls"


strCon = "Data Source=" & strFileName & ";" &
_

"Extended Properties=""Excel 8.0;HDR=Yes;"""
Set cn =
CreateObject("ADODB.Connection")


cn.Provider = "Microsoft.ACE.OLEDB.12.0"


'.Provider =
"Microsoft.Jet.OLEDB.4.0"
cn.ConnectionString = strCon


cn.Open


Set rsSchema = cn.OpenSchema(adSchemaTables, Array(Empty,
Empty, Empty, Empty))


rsSchema.MoveFirst


strShName = rsSchema.Fields(2).Value


' add criteria here if required

strSQL = "SELECT * FROM [" & strShName & "]"


Set rsData = CreateObject("ADODB.Recordset")


rsData.Open strSQL, cn


rsData.Filter = "[" & rsData.Fields(0).Name & "] =
'ARGTM'"


For Each fld In
rsData.Fields
rngDst.Offset(, I) =
fld.Name
I = I +
1
Next fld


rngDst.Offset(1).CopyFromRecordset rsData


cn.Close


Set cn = Nothing


End Sub


If you run this you'll notice another problem - we lose the 'real' field names.

I think what could be done there is extract them before filtering.

theta
02-01-2012, 10:25 AM
I get an error on this line. It is being cut off as a comment from 'ARGTM'", how do i prevent this?



rsData.Filter = "[" & rsData.Fields(0).Name & "] = " 'ARGTM'"

theta
02-02-2012, 02:18 AM
Hmmm got it working and get the same problems you are having.

Any ideas to get it working? Very frustrating, but at least it's nearly there :)