PDA

View Full Version : copying data from a closed workbook



ravinder_tig
05-27-2009, 10:01 PM
Hi Guys
I'm New to VBA so having a problem with one of my project in which i had to paste the data To A file named Master Report and from where that data is coming is named Process which i snot opened for copying
Finally what i had to do is i had to place multiple process sheets into one master but right now i 'm having a problem with my macro
the problem is i had intitiated active x 2.5 lib reference and with help of a code on net i'm able to create a macro for my project which copies the data with help of ADO Record set
But Thsi Record set is not working correctly and only some data (Not Whole Data) is being copied in master file
I'm Attaching the macro as well as files both Master Report and Process
plz help me with this


Option Explicit

Sub Copy()
GetData ThisWorkbook.Path & "\Process.xls", "Sheet1", _
"E4:AA22", Sheets("Sheet1").Range("E4:AA22"), False, False
End Sub
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



with recordset
I had find out the problem also whenevr i do take integers more in a column it copies integer but when alpabets are more it only copies alphabets

possible solution : copying data row by row so each column for that specific row is unique
but thisisn't gud coz going to take more time and memory

could i use other thing than recordset

but i do need both

Your Help Will Be Gr8ly Appriciated
Regards,
Ravinder S

GTO
05-28-2009, 01:43 AM
Greetings,

Probably not much help, as what I know about ADO is shorter than this sentence.

While certainly not very "adjustable", you seem to have a consistent range to grab from. Have you tried just wacking in an array formula and overwriting it with the vals?

Maybe:

Sub CopySimple()
Dim strPath

strPath = ThisWorkbook.Path & Application.PathSeparator
strPath = "=IF('" & strPath & "[Process.xls]Sheet1'!R4C5:R22C27<>"""",'" & _
strPath & "[Process.xls]Sheet1'!R4C5:R22C27,"""")"

With ThisWorkbook.Worksheets("Sheet1") '<--- or codename
.Range("E4:AA22").FormulaArray = strPath
.Range("E4:AA22").Value = .Range("E4:AA22").Value
End With
End Sub


Mark

Edit: realized that blanks would come over as zeros...