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





Reply With Quote

Bookmarks