I guess the most efficient way would be to export the data using ADO.
If you export each sheet as patel explained, you can use this method providing you did not add a header/fieldnames row.
[SOLVED] Import multiple files from same directory
Code:'http://spreadsheetpage.com/index.php/tip/getting_a_list_of_file_names_using_vba/ Sub MakeCSVMasters() Dim p As String, x() As Variant, i As Integer p = ThisWorkbook.Path & "\?-?????? *.csv" x() = GetFileList(p) Select Case IsArray(x) Case True 'files found 'MsgBox UBound(x), , "Count of Found Files" 'Sheets("Sheet1").Range("A:A").Clear 'For i = LBound(x) To UBound(x) ' Sheets("Sheet1").Cells(i, 1).Value = x(i) 'Next i MakingCSVMasters ThisWorkbook.Path, x() Case False 'no files found MsgBox "No matching files" End Select End Sub Sub MakingCSVMasters(pPath As String, a() As Variant) Dim x() As Variant, y() As Variant, xv As Variant, yv As Variant Dim z() As Variant, zv As Variant, i As Integer, s As String x() = UniqueArray(a) 'MsgBox Join(x, vbLf) ReDim y(LBound(x) To UBound(x)) i = LBound(x) - 1 For Each xv In x() 'MsgBox Join(Filter(a(), xv, True), " ") 'Add Parent Path, pPath, and embed quotes around full file name 'and bulid string for COPY s = vbNullString i = i + 1 For Each zv In Filter(a(), xv, True) '+ sign is the COPY concatenation operator s = s & "+" & """" & pPath & "\" & zv & """" Next zv y(i) = Right(s, Len(s) - 1) 'Trim first "+" character 'MsgBox Join(y(), vbLf) Next xv For i = LBound(y) To UBound(y) s = "cmd /c Copy " & y(i) & " " & """" _ & pPath & "\Master_" & Left(x(i), 8) & ".csv" & """" 'Debug.Print s Shell s, vbHide Next i End Sub Function UniqueArray(inArray() As Variant) As Variant Dim it As Variant, sn() As Variant, c00 As Variant With CreateObject("scripting.dictionary") For Each it In inArray() c00 = .Item(Left(CStr(it), 8)) Next sn = .Keys ' the array .keys contains all unique keys 'MsgBox Join(sn, vbLf) ' you can join the array into a string End With UniqueArray = sn End Function Function GetFileList(FileSpec As String) As Variant ' Returns an array of filenames that match FileSpec ' If no matching files are found, it returns False Dim FileArray() As Variant Dim FileCount As Integer Dim FileName As String On Error GoTo NoFilesFound FileCount = 0 FileName = Dir(FileSpec) If FileName = "" Then GoTo NoFilesFound ' Loop until no more matching files are found Do While FileName <> "" FileCount = FileCount + 1 ReDim Preserve FileArray(1 To FileCount) FileArray(FileCount) = FileName FileName = Dir() Loop GetFileList = FileArray Exit Function ' Error handler NoFilesFound: GetFileList = False End Function




Reply With Quote
Bookmarks