Snasui Excel Forum

Code: Select all

Sub ImportItemMaster()
    Dim strPath As Variant, i As Integer
    Dim fName As String, nb As Workbook
    Dim tb As Workbook, ans As Integer, lngLast As Long
    
    Set tb = ThisWorkbook
    
    strPath = Application.GetOpenFilename("Text files(*.txt*),*.txt*", _
        Title:="Please select text files.", MultiSelect:=True)
    If TypeName(strPath) = "Boolean" Then Exit Sub

    For i = 1 To UBound(strPath)
        For p = 1 To 4
        
        fName = VBA.Left(strPath(i), InStr(strPath(i), ".")) & "xlsx"
        Workbooks.OpenText Filename:=strPath(i), origin:=65001, _
        startrow:=1, DataType:=xlDelimited, textQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, other:=True, OtherChar:="|", fieldinfo:=Array(Array(1, 2 _
        ), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
        , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
        Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
        28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
        Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
        41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
        Array(48, 1)), TrailingMinusNumbers:=True
        
        lngLast = Range("A" & Rows.Count).End(xlUp).Row
        With ActiveWorkbook
            Sheets(1).Select
            Range("a1:av" & lngLast).Copy
        End With

        With tb.Sheets("Item" & p)
            Sheets("Item" & p).Select
            .Range("a1").PasteSpecial xlPasteValues
            
        End With
        
        Application.CutCopyMode = False
        
        Workbooks("ITEMMASTER.TXT-" & R & ".txt*").Close

        Next p
    Next i
    MsgBox "Finish."
End Sub

Code: Select all

Dim sh As Worksheet, i As Integer
Dim strPath As Variant, q As Object
strPath = Application.GetOpenFilename(FileFilter:="Text File(s) (*.txt),*.txt*", _
    MultiSelect:=True)
If TypeName(strPath) = "Boolean" Then Exit Sub
For Each sh In ThisWorkbook.Worksheets
    If sh.Index > 1 Then
        i = i + 1
        With sh.QueryTables.Add(Connection:= _
            "TEXT;" & strPath(i), Destination:=sh.Range("a1"))
            .Name = VBA.Right(strPath(i), InStr(StrReverse(strPath(i)), "\") - 1)
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 65001
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileOtherDelimiter = "|"
            .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)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
    End If
    For Each q In sh.QueryTables
        q.Delete
    Next
Next sh