Excel to Excel Data transfer without opening any of the files(source or target)

[Transformer]

If you want to transfer data from one excel file to another then you can use the following procedure.
code:


Sub TransferData(strInputFileFullName As String, strOutPutFileFullName As String, strInputSheetName As String)

Dim adoConnection As New ADODB.Connection
Dim adoRcdSource As New ADODB.Recordset

adoConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= " & strOutPutFileFullName & ";Extended Properties=""Excel 8.0;HDR=YES"";"
adoRcdSource.Open "Select * into [" & strInputSheetName & "] From [" & strInputSheetName & "] IN '" & strInputFileFullName & "'[Excel 8.0;HDR=YES;]", adoConnection

End Sub





call TransferData("E:\source.xls","E:\Destination.xls","shtData")


If target workbook is not available in the destination drive then it will create it automatically and transfer the data.
eg. if in above example if Destination.xls is not available then it will create it with the sheet "shtData"


Regards,
Transformer

[Rick Rothstein]

If you want to transfer data from an excel file to another then you can use the following procedure.
code:


Sub TransferData(strInputFileFullName As String, strOutPutFileFullName As String, strInputSheetName As String)

Dim adoConnection As New ADODB.Connection
Dim adoRcdSource As New ADODB.Recordset

adoConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= " & strOutPutFileFullName & ";Extended Properties=""Excel 12.0 Macro;HDR=YES"";"
adoRcdSource.Open "Select * into [" & strInputSheetName & "] From [" & strInputSheetName & "] IN '" & strInputFileFullName & "'[Excel 8.0;HDR=YES;]", adoConnection

End Sub





call TransferData("E:\source.xls","E:\Destination.xls","shtData")


If target workbook is not available in the destination drive then it will create it automatically and transfer the data.
eg. if in above example if Destination.xls is not available then it will create it with the sheet "shtData"

I am not a "database person" myself, so I do not know the answer to this question... Do any of the three text sections I highlighted in red in any way restrict the functionality of your subroutine to a specific version of Excel or, perhaps, a specific version of some database engine?

[Admin]

Hi Transformer,

Welcome to board !!!

Couple of things.

Tell the users that they need to add the references
1. Microsoft ActiveX Data Objects 2.x Library
2. Microsoft ActiveX Data Objects Recordset 2.x Library

secondly, you need '$' followed by the sheet name, like


adoRcdSource.Open "Select * into [" & strInputSheetName & "] From [" & strInputSheetName & "$] IN '" & strInputFileFullName & "'[Excel 8.0;HDR=YES;]", adoConnection

Expect many more from you !!

[Rajan_Verma]

I am not a "database person" myself, so I do not know the answer to this question... Do either, or both, of the text sections I highlighted in red in any way restrict the functionality of your subroutine to a specific version of Excel or, perhaps, a specific version of some database engine?


Hi Rick,

this will work on 2007 and 2010

Rajan

[Transformer]

Oh yes I forgot.Thanx Admin :)

[Rick Rothstein]

Hi Rick,

this will work on 2007 and 2010

Rajan
Thanks for the info. I mainly use XL2003... can either, or both, of those numbers be changed to make it work on XL2003? What about earlier versions of Excel?

[Rajan_Verma]

Hi Rick
you can change the Provider .
Replace "Provider=Microsoft.ACE.OLEDB.12.0" with "Provider =Microsoft.Jet.OLEDB.4.0"

Rajan.

[Transformer]

Hi Rick,
You can use this
adoConnection.Open "Provider=Microsoft.JET.OLEDB.4.0;Data Source= " & strOutPutFileFullName & ";Extended Properties=""Excel 8.0;HDR=YES"";"

[Rick Rothstein]

Hi Rick,
You can use this
adoConnection.Open "Provider=Microsoft.JET.OLEDB.4.0;Data Source= " & strOutPutFileFullName & ";Extended Properties=""Excel 8.0;HDR=YES"";"
Thanks Transformer and Rajan_Verma for the extra information. Without actually trying your code out yet, but based on the extra information you have provided, the following code should be able to work on XL2003 or above (I don't know about earlier versions of Excel because I am not sure whether the extra information covers them or not)...


Sub TransferData(strInputFileFullName As String, strOutPutFileFullName As String, strInputSheetName As String)

Dim adoConnection As New ADODB.Connection
Dim adoRcdSource As New ADODB.Recordset
Dim Provider As String
Dim ExtProperties As String

If Application.Version = "11.0" Then
Provider = "Microsoft.JET.OLEDB.4.0"
ExtProperties = "Excel 12.0"
Else
Provider = "Microsoft.ACE.OLEDB.12.0"
ExtProperties = "Excel 8.0"
End If

adoConnection.Open "Provider=" & Provider & ";Data Source= " & strOutPutFileFullName & ";Extended Properties=""" & ExtProperties & ";HDR=YES"";"
adoRcdSource.Open "Select * into [" & strInputSheetName & "] From [" & strInputSheetName & "] IN '" & strInputFileFullName & "'[Excel 8.0;HDR=YES;]", adoConnection

End Sub

[Transformer]

Hi Rick,

Revised Sub is



Sub TransferData(strInputFileFullName As String, strOutPutFileFullName As String, strInputSheetName As String)

Dim adoConnection As New ADODB.Connection
Dim adoRcdSource As New ADODB.Recordset
Dim Provider As String
Dim ExtProperties As String
Dim strFileExt As String


If Len(Dir(strInputFileFullName)) = 0 Then
MsgBox "Input file does not exist"
Exit Sub
End If
strFileExt = Mid(strOutPutFileFullName, InStrRev(strOutPutFileFullName, ".", -1, vbTextCompare), Len(strOutPutFileFullName))
If strFileExt = ".xlsx" Then
ExtProperties = "Excel 12.0 XML"
Else
ExtProperties = "EXCEL 8.0"
End If
If CDbl(Application.Version) > 11 Then
Provider = "Microsoft.ACE.OLEDB.12.0"
Else
Provider = "Microsoft.JET.OLEDB.4.0"
End If

adoConnection.Open "Provider=" & Provider & ";Data Source= " & strOutPutFileFullName & ";Extended Properties=""" & ExtProperties & ";HDR=YES"";"
adoRcdSource.Open "Select * into [" & strInputSheetName & "] From [" & strInputSheetName & "$] IN '" & strInputFileFullName & "'[" & ExtProperties & ";HDR=YES;]", adoConnection


adoConnection.Close

Set adoRcdSource = Nothing
Set adoConnection = Nothing

End Sub

[Rick Rothstein]

Thanks for the corrected code... much appreciated.

By the way, for this line of code...



strFileExt = Mid(strOutPutFileFullName, InStrRev(strOutPutFileFullName, ".", -1, vbTextCompare), Len(strOutPutFileFullName))
you can omit the last two arguments for the InStrRev function call... the next to last argument defaults to -1 when omitted and since you are searching for a "dot", you don't need to to a "text compare" (which slows down the InStrRev function). So, I would write that line like this...


strFileExt = Mid(strOutPutFileFullName, InStrRev(strOutPutFileFullName, "."), Len(strOutPutFileFullName))

[Transformer]

In case of XL2007 it will be able to transfer data between xlsx and xls files both but in case of XL2003 it can transfer between xls files only.

[Admin]

Hi Transformer,

Great work !! :cheers:

[technicalupload]

Hi Transformer

Highly impressive :cool:

Thanks!

[sbglobal2012]

Expediently, I set a certain time with task scheduler. When the time is up, Macro Expert automates to transfer data from excel to the website.