[已解决]请教，各位高手我想用vba实现读取多个txt文件数据请问怎么实现？

qinshuai8507

苏子龙 发表于 2017-6-12 15:57
自己照着改改吧

好的，已经非常完美了，谢谢。

qinshuai8507

苏子龙 发表于 2017-6-12 15:57
自己照着改改吧

高手你好，有段代码麻烦给看下，这个代码读取数据后老是增加，如何修改下能让它覆盖原数据呢？
Sub 读取数据()
    fileToOpen = Application.GetOpenFilename("文本(*.txt), *.txt", , "读取数据")
    If fileToOpen = False Then
        Exit Sub
    End If
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fileToOpen, Destination:=Range("A1"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

苏子龙

qinshuai8507 发表于 2017-6-28 09:36
高手你好，有段代码麻烦给看下，这个代码读取数据后老是增加，如何修改下能让它覆盖原数据呢？
Sub 读取 ...

重新开帖，上传文件，说清要求，这样便于沟通！

qinshuai8507

苏子龙 发表于 2017-6-28 09:43
重新开帖，上传文件，说清要求，这样便于沟通！

好的

qinshuai8507

你好大侠，这个代码如何能升级下手动选择目录读取？

qinshuai8507

苏子龙 发表于 2017-6-12 15:57
自己照着改改吧

你好大侠，这个代码如何能升级下手动选择目录读取？

苏子龙

fileToOpen = Application.GetOpenFilename("文本(*.txt), *.txt", , "读取数据")
    If fileToOpen = False Then
        Exit Sub
    End If
这个不是手动选取吗？

qinshuai8507

苏子龙 发表于 2017-6-30 10:40
fileToOpen = Application.GetOpenFilename("文本(*.txt), *.txt", , "读取数据")
    If fileToOpen = Fa ...

Sub test()
Dim arr, rw%, i%, flm$
On Error Resume Next
Sheet1.UsedRange.ClearContents
flm = Dir(ThisWorkbook.Path & "/*.txt")
Do While flm <> ""
    rw = rw + 1
    Open ThisWorkbook.Path & "/" & flm For Input As #1
        arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
    Close #1
    With Sheet1
           .Cells(rw, 1) = Split(arr(1), ",")(0)
           .Cells(rw, 2) = Split(arr(6), ",")(2)
           .Cells(rw, 3) = Split(arr(6), ",")(6)
    End With
    flm = Dir
Loop
End Sub
就是大侠之前这段代码，怎么修改下能弹出个自己能选择文件夹路径的框然后读取这个文件夹中的文件。

jianbo527

论坛里好多大师

苏子龙

Sub test()
Dim arr, rw%, i%, flm$
Dim Fd As FileDialog, ph As String
On Error Resume Next
  Set Fd = Application.FileDialog(msoFileDialogFolderPicker)
  Fd.Title = "请选择你包含文件的文件夹"
  If Fd.Show = -1 Then
  ph = Fd.SelectedItems(1)
  Else
    Exit Sub
  End If
Sheet1.UsedRange.ClearContents
flm = Dir(ph & "/*.txt")
Do While flm <> ""
    rw = rw + 1
    Open ph & "/" & flm For Input As #1
        arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
    Close #1
    With Sheet1
           .Cells(rw, 1) = Split(arr(1), ",")(0)
           .Cells(rw, 2) = Split(arr(6), ",")(2)
           .Cells(rw, 3) = Split(arr(6), ",")(6)
    End With
    flm = Dir
Loop
End Sub