CSV文件导出

时间:2019-10-08 14:05:09

标签: excel vba

我想将多个txt文件放入单个工作表中,我已经尝试了下面的代码,但是并不能在工作表中的现有数据下面处理数据。

数据覆盖了现有数据。

Sub QueryImportText()
    Dim sPath As String, sName As String
    Dim LR As Long, qt As QueryTable

    sPath = "F:\WIN7PROFILE\Desktop\New folder\"
    sName = Dir(sPath & "*.txt")
    LR = Sheets("Log").UsedRange.Rows.Count
    Do While sName <> ""
        LR = LR + 1
'        Range("A" & LR).Value = sName
        With Sheets("Log").QueryTables.Add(Connection:= _
            "TEXT;" & sPath & sName, Destination:=Range("A" & LR))
        .Name = Left(sName, Len(sName) - 4)
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "|"
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        End With
        sName = Dir()
        For Each qt In ActiveSheet.QueryTables
            qt.Delete
        Next
    Loop
End Sub

您能为我提供正确的代码吗,以便将所有txt文件都粘贴到“日志”表中的另一个文件中

0 个答案:

没有答案