Hi Rick,
Revised Sub is
Code:
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
Bookmarks