Posts Tagged ‘Transfer’

Sometimes one might need to export data from one Excel file to another and if one wants to do so without opening any of those files (Source and destination files), then it can be done using the following procedure.

It has four parameters, last of which is optional:
1. strSourceFileFullName : Full name of the source file with extension. e.g. “C:\Challenge1.xlsx”
2. strTargetFileFullName : Full name of the target file with extension. e.g. “C:\Challenge2.xlsx”
3. strSourceSheetName : Sheet name from where data needs to be exported.
4. strTargetSheetname : Sheet name in the target file where data should be pasted. This is an optional parameter. If this parameter is not passed then a new sheet will be created with the same name as the source sheet.

Sub TransferData(strSourceFileFullName As String, _
                 strTargetFileFullName As String, _
                 strSourceSheetName As String, _
                 Optional strTargetSheetname As Variant)

    Dim adoConnection   As Object
    Dim adoRcdSource    As Object
    Dim Provider        As String
    Dim ExtProperties   As String
    Dim strFileExt      As String

    Set adoConnection = CreateObject("ADODB.Connection")
    Set adoRcdSource = CreateObject("ADODB.Recordset")
    If Len(Dir(strSourceFileFullName)) = 0 Then
        MsgBox "Input file does not exist"
        Exit Sub
    End If

    strFileExt = Mid(strTargetFileFullName, InStrRev(strTargetFileFullName, ".", -1, vbTextCompare), Len(strTargetFileFullName))

    If strFileExt = ".xlsx" Then
        ExtProperties = "Excel 12.0 XML"
    ElseIf strFileExt = ".xlsb" Then
        ExtProperties = "Excel 12.0"
    ElseIf strFileExt = ".xlsm" Then
        ExtProperties = "Excel 12.0 Macro"
        ExtProperties = "EXCEL 8.0"
    End If

    If CDbl(Application.Version) > 11 Then
      Provider = "Microsoft.ACE.OLEDB.12.0"
       Provider = "Microsoft.JET.OLEDB.4.0"
    End If

    If IsMissing(strTargetSheetname) Then
        strTargetSheetname = strSourceSheetName
    End If
    adoConnection.Open "Provider=" & Provider & ";Data Source= " & strTargetFileFullName & ";Extended Properties=""" & ExtProperties & ";HDR=YES"";"

    On Error GoTo Errorhandler
    adoRcdSource.Open "Select * into [" & strTargetSheetname & "] From [" & strSourceSheetName & "$] IN '" & strSourceFileFullName & "'[" & ExtProperties & ";HDR=YES;]", adoConnection
    If Err.Number = -2147217900 Then
        MsgBox "A sheet or a named range with the same name already exists in the target workbook. Data will not be copied.", , "Name Conflict"
    End If

    Set adoRcdSource = Nothing
    Set adoConnection = Nothing

End Sub

Note: If a file with the name ‘strTargetFileFullName’ is not found then it gets created automatically in the target folder but if you want to transfer data into an xlsm file than it must be there. It won’t be created automatically.
If you face any problems, email us or leave a reply.