Importing quoted text file

**dschmitt** · 05-19-2010, 09:06 PM

Now I have the time to get back to this problem. And I want to try a new approach.

I have a macro that can import several XML files. I want to change the macro so that it can import instead several comma delimited text files.

To illustrate I attached an Excel file called example.xlsm which contains the macro. I also attached 2 xml files. Please change the the file names from .txt to .xml. With these xml files you can test the macro. You can execute the macro by clicking on the AuthorAnalysis button on the far right in the Home menubar. This macro is working fine.

I also attached 2 comma delimited text files (1.txt; 2.txt). These are the files that I want the new macro to import.

I tried to solve this problem by first using the macro recorder followed by using the macro recorder code to modify the xml import macro. Unfortunately I was not successfull.

**dschmitt** · 05-20-2010, 12:06 AM

boiling down the problem to the essential ...

how would I have to change the following code so that it will import a comma delimited text file?

ActiveWorkbook.XmlImport URL:=FileName2, ImportMap:=Nothing, Overwrite:= _
    True, Destination:=Range("$A$1")

**dschmitt** · 05-20-2010, 12:57 AM

below is the code of the entire macro.

Sub ImportMultipleXMLfiles()

    Application.ScreenUpdating = False

'Define variables
    
    Dim Filt As String
    Dim FilterIndex As Integer
    Dim Title As String
    Dim FileName As Variant
    Dim FileName2 As Variant
    Dim i As Integer
    Dim j As Integer


'Select files to Import

    'Set up list of file filters
        Filt = "XML Files (*.xml) ,*.xml,"

    'Display * * by default
        FilterIndex = 5

    'Set the dialog box caption
        Title = "Select a File to Import"

    'Get the file name
        FileName = Application.GetOpenFilename _
            (FileFilter:=Filt, _
            FilterIndex:=FilterIndex, _
            Title:=Title, _
            MultiSelect:=True)

    'Exit if dialog box canceled
        If Not IsArray(FileName) Then Exit Sub


'Create and delete sheets
    
    Sheets.Add
    ActiveSheet.Name = "1"

    Application.DisplayAlerts = False
      
      For Each Sht In ActiveWorkbook.Worksheets
        If Sht.Name <> "1" Then Sht.Delete
      Next Sht

    Application.DisplayAlerts = True


'Create sheets, one for each file to import
       
    For j = LBound(FileName) To UBound(FileName) - 1
        Sheets.Add After:=Sheets(j)
        Sheets(j + 1).Select
        Sheets(j + 1).Name = j + 1
    Next j


'Import files

        For i = LBound(FileName) To UBound(FileName)
            Sheets(i).Select
            FileName2 = FileName(i)
            ActiveWorkbook.XmlImport URL:=FileName2, ImportMap:=Nothing, Overwrite:= _
                True, Destination:=Range("$A$1")
            Cells.Select
            Selection.RowHeight = 12.5
            Selection.ColumnWidth = 15
        Next i
    
    
    Application.ScreenUpdating = True
    
End Sub

**dschmitt** · 05-20-2010, 03:24 AM

I am trying another approach to get a solution to my problem.
Attached is an Excel file with the macro and one comma delimited text file.

The following code gives me an error in the first line of the Import file code

Sub Macro1()

'Define variables
    
    Dim Filt As String
    Dim FilterIndex As Integer
    Dim Title As String
    Dim FileName As Variant

'Select file to Import

        Filt = "Txt Files (*.txt) ,*.txt,"
        FilterIndex = 5
        Title = "Select a File to Import"
        FileName = Application.GetOpenFilename _
            (FileFilter:=Filt, _
            FilterIndex:=FilterIndex, _
            Title:=Title, _
            MultiSelect:=True)
        If Not IsArray(FileName) Then Exit Sub

'Import file

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;FINDER" & FileName, Destination:=Range("$A$1"))
        .Name = "1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 932
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

End Sub