VBA Problems importing multiple csv files into one workbook on seperate tabs.

[a15457]

Hello again all,

Firstly I'm running Excel 2013 x32bit on win 8.1 x64. I'm far from a VBA guru, I prefer to rate my skills as a VBA scrapbooker.

After lots of googling I've managed to cobble together a VBA script that will import multiple CSV files into one workbook, however I still have a couple of issues with what I've pulled together.

Issue 1 is that the code, (that I'll paste below), barfs after importing 30 odd csv files citing a run-time error 7 out of memory. (This is the BIG issue that I need to try and resolve as I have about 90 odd files that I need to import.)

Issue 2 is that I have a second block of code that is supposed to format the imported csv file tabs as tables and a couple of other things. This errors out if I try and run it as part of the main sub, however if I save the workbook, close it, re-open it and run the "formatting" code it works perfectly. I can live with the close / re-open solution but would prefer to not have to if I can get away with it. The error that I get is "Run-time error '1004': A table cannot overlap a range that contains a PivotTable report, query results, protected cells or another table."

Option Explicit
Sub ImportTextFiles()
' ********************
' The purpose of this Macro is to import all txt files ...
' from the folder the Workbook is in with each file going to ...
' separate Worksheets in the Workbook.
'
' It has been cobbled together using various bits of scripts that I've found on the internet.
'
' ********************
' ~~~~~~~~~~~~~~~~~~~~
' Declare & set Variables as required and set constants as necessary.
' ~~~~~~~~~~~~~~~~~~~~
Dim fPath           As String
Dim fCSV            As String
Dim fname           As String
Dim TabName         As String
Dim fExt            As String
Dim idx             As Integer
Dim ws              As Worksheet
Dim tbl             As ListObject
Dim wbMST           As Workbook
Dim oFS             As Object
Dim strFilename     As String
Dim strDateCreated  As String
Set wbMST = ActiveWorkbook
' ~~~~~~~~~~~~~~~~~~~~
' Set the file extension as required.
' Eg: "txt", "csv"
' ~~~~~~~~~~~~~~~~~~~~
fExt = "csv"
' ~~~~~~~~~~~~~~~~~~~~
' The next line sets the path that the Workbook is in and the search for the text files will begin there.
' ~~~~~~~~~~~~~~~~~~~~
fPath = ActiveWorkbook.Path & "\"
' ~~~~~~~~~~~~~~~~~~~~
' DisableScreenupdating and alert messages.
' ~~~~~~~~~~~~~~~~~~~~
Application.ScreenUpdating = False
Application.DisplayAlerts = False
fname = Dir(fPath & "*." & fExt)
While (Len(fname) > 0)
    idx = idx + 1
    TabName = Left(fname, 31)
    Sheets.Add.Name = TabName
' ~~~~~~~~~~~~~~~~~~~~
' In the next block of code you may have to edit multiple lines depending on what your delimiter is in the text file.
'
' Currently it is set up for a comma (,) delimiter.
' ~~~~~~~~~~~~~~~~~~~~
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fPath & fname, Destination:=Range("$A$1"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=True
        .MaintainConnection = False
        fname = Dir
        
    End With
    
    ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count)
Wend
' ~~~~~~~~~~~~~~~~~~~~
' Remove Connections.
' This next bit should remove all the connections to the External Files.
' ~~~~~~~~~~~~~~~~~~~~
Do While ActiveWorkbook.Connections.Count > 0
    ActiveWorkbook.Connections.Item(ActiveWorkbook.Connections.Count).Delete
Loop
' ~~~~~~~~~~~~~~~~~~~~
' Remove Named Ranges.
' This next bit should remove all the Named Ranges in the workbook.
' ~~~~~~~~~~~~~~~~~~~~
Dim nm As Name
On Error Resume Next
For Each nm In ActiveWorkbook.Names
    nm.Delete
Next
On Error GoTo 0
' ~~~~~~~~~~~~~~~~~~~~
' Format The imported Sheets.
' ~~~~~~~~~~~~~~~~~~~~
Application.ScreenUpdating = True
For Each ws In Worksheets
    If ws.Name <> "Version Control" Then
        If ws.Name <> "Pivot" Then
            If ws.Name <> "SearchPage" Then
                Worksheets(ws.Name).Activate
                For Each tbl In ActiveSheet.ListObjects
                    tbl.Unlist
                Next
                ws.Select
                ActiveWindow.Zoom = 80
            End If
        End If
    End If
    
Call SaveWorkBook
Next ws
Application.ScreenUpdating = False
' ~~~~~~~~~~~~~~~~~~~~
' Clean up and record update data.
' ~~~~~~~~~~~~~~~~~~~~

' ~~~~~~~~~~~~~~~~~~~~
' Put your filename here.
' This filename will be the one used as a reference for the "update date"
' ~~~~~~~~~~~~~~~~~~~~
strFilename = fPath & "[I]filename[/I].csv"

' ~~~~~~~~~~~~~~~~~~~~
' This creates an instance of the MS Scripting Runtime FileSystemObject class
' ~~~~~~~~~~~~~~~~~~~~
Set oFS = CreateObject("Scripting.FileSystemObject")
strDateCreated = oFS.GetFile(strFilename).DateCreated
Worksheets("SearchPage").Activate
ActiveSheet.Cells(5, 6) = strDateCreated
ActiveSheet.Cells(5, 2).Select
Call SaveWorkBook
Set oFS = Nothing
Set ws = Nothing
Set wbMST = Nothing
End Sub

 

[a15457]

Hey guys ... small update ... the out of memory error is due to me trying to import an empty csv file.

So I guess it's now just down to issue 2 with the formatting weirdness.

Cheers,

Dave

 

[a15457]

Spewing that no-one has a workaround or resolution for Issue 2 listed in the first post of this thread. Oh well I'll just have to live with the close and open workaround.

Thanks anyway guys.

Cheers,

Dave