Question

需要帮助找出我的代码没有循环的原因我的文件夹。它一遍又一遍地循环相同的文本文件。当我放下并运行代码，看来下一个文件就行了是正确的，但它会打开前一个文件。

     Sub MikesMacro()

     Dim strFile As String
     Dim intNumberOfFiles As Integer
     Dim wbText As Excel.Workbook
     Dim path As String

     path = "C:\Users\MStarks\Desktop\Cincy Data Edits\PULSE IMPORTS\"

     strFile = Dir(path & "*.TXT")

         Do While Len(strFile) <> ""

         Workbooks.OpenText Filename:=(path & "*.TXT") _
         , DataType:=xlDelimited, Tab:=True, FieldInfo:=Array(Array(1, 1), _
         Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1))

         Set wbText = ActiveWorkbook

         'Starts the macro used to set up format the Telog likes
         'Macro not included
         'start save as .CSV cycle

     strFile = Dir

     Loop

     End Sub

Answer 1

这个怎么样？

Sub LoadPipeDelimitedFiles()
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xCount As Long
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Application.ScreenUpdating = False
    xFile = Dir(xStrPath & "\*.txt")
    Do While xFile <> ""
        xCount = xCount + 1
        Sheets(xCount).Select
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
          & xStrPath & "\" & xFile, Destination:=Range("A1"))
            .Name = "a" & xCount
            .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 = False
            .TextFileSpaceDelimiter = False
            .TextFileOtherDelimiter = "|"
            .TextFileColumnDataTypes = Array(1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
            xFile = Dir
        End With
    Loop
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox("no txt files")
End Sub

https://www.extendoffice.com/documents/excel/3388-excel-import-multiple-text-csv-xml-files.html

VBA循环文件夹中的文本分隔文件并导出为csv

1 个答案: