立即将100个文本文件导入Excel [英] Importing 100 text files into Excel at once

问题描述

我有这个宏批量导入excel电子表格包含在同一个文件夹中的100+ .txt文件：

  Sub QueryImportText（）
 Dim sPath As String，sName As String 
 Dim i As Long，qt As QueryTable 
 With ThisWorkbook 
 .Worksheets.Add After：= _ 
。工作表（.Worksheets.Count）
结束
 ActiveSheet.Name =格式（现在，yyyymmdd_hhmmss）
 sPath =C：\Users\TxtFiles\
 sName = Dir（sPath&* .txt）
i = 0 
尽管sName<> 
i = i + 1 
 Cells（1，i）.Value = sName 
 With ActiveSheet.QueryTables.Add（Connection：= _ 
TEXT;& sPath & sName，Destination：= Cells（2，i））
 .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 = 437 
 .TextFileStartRow = 1 
 .TextFileParseType = xlDelimited 
 .TextFileTextQualifier = xlTextQualifierDoubleQuote 
 .TextFileConsecutiveDelimiter = False 
 .TextFileTa bDelimiter = True 
 .TextFileSemicolonDelimiter = False 
 .TextFileCommaDelimiter = False 
 .TextFileSpaceDelimiter = False 
 .TextFileColumnDataTypes = Array（1）
 .TextFileTrailingMinusNumbers = True 
 .Refresh BackgroundQuery：= False 
结束
 sName = Dir（）
对于每个qt在ActiveSheet.QueryTables 
 qt.Delete 
下一个
循环
 End Sub 
  

每个.txt文件具有相同的结构：
title，ID ，日期，createdBy，文本。

宏正在工作，但是

• 我想要每个文件在一行（这个宏显示在列中）

这个excel将通过导出为.csv在我的joomla网站导入MySql

非常感谢您的帮助！

解决方案

我不建议使用数组来执行整个操作。以下代码 1秒处理300个文件

LOGIC：

1. 循环通过具有文本文件的目录


2. 打开文件并一次读取数组然后关闭文件。


3. 将结果存储在临时数组中


4. 读取所有数据后，只需将数组输出到Excel Sheet <
   

CODE：（试用和测试）

 '~~>更改路径
 Const sPath As String =C：\Users\Siddharth Rout\Desktop\DeleteMelater\
 
子样本（）
 Dim wb As工作簿
 Dim ws As Worksheet 
 
 Dim MyData As String，tmpData（）As String，strData（）As String 
 Dim strFileName As String 
 
' ~~>您的要求是267个文件，每行1行，但我创建
'~~>一个数组大到可以处理1000个文件
 Dim ResultArray（1000,3）As String 
 
 Dim i As Long，n As Long 
 
 Debug.Print过程开始于：&现在
 
 n = 1 
 
设置wb = ThisWorkbook 
 
'~~>将此更改为相关工作表
设置ws = wb.Sheets（Sheet1）
 
 strFileName = Dir（sPath&\ * .txt）
 
'~~>循环通过文件夹获取文本文件
 Do While Len（strFileName）> 0 
 
'~~>一次打开文件并将其读入数组
打开sPath& \& strFileName For Binary As＃1 
 MyData = Space $（LOF（1））
获取＃1，MyData 
关闭＃1 
 strData（）= Split（MyData，vbCrLf ）
 
'~~>收集结果数组中的信息
对于i = LBound（strData）到UBound（strData）
如果Len（Trim（strData（i））） 0然后
 tmpData = Split（strData（i），，）
 
 ResultArray（n，0）=替换（tmpData（0），Chr（34），）
 ResultArray（n，1）=替换（tmpData（1），Chr（34），）
 ResultArray（n，2）=替换（tmpData（2），Chr（34） ）
 ResultArray（n，3）=替换（tmpData（3），Chr（34），）
 
n = n + 1 
结束If 
下一步i 
 
'~~>获取下一个文件
 strFileName = Dir 
循环
 
'~~>将数组写入Excel表
 ws.Range（A1）。调整大小（UBound（ResultArray），_ 
 UBound（Application.Transpose（ResultArray）））= ResultArray 
 
 Debug.Print过程结束于：&现在
 End Sub 
  

I have this macro to bulk import in a excel spreadsheet 100+ .txt files contained in the same folder :

Sub QueryImportText()
    Dim sPath As String, sName As String
    Dim i As Long, qt As QueryTable
    With ThisWorkbook
        .Worksheets.Add After:= _
            .Worksheets(.Worksheets.Count)
    End With
    ActiveSheet.Name = Format(Now, "yyyymmdd_hhmmss")
    sPath = "C:\Users\TxtFiles\"
    sName = Dir(sPath & "*.txt")
    i = 0
    Do While sName <> ""
        i = i + 1
        Cells(1, i).Value = sName
        With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;" & sPath & sName, Destination:=Cells(2, i))
            .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 = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        sName = Dir()
        For Each qt In ActiveSheet.QueryTables
            qt.Delete
        Next
    Loop
End Sub

Each .txt file has the same structure: title, ID, date, createdBy, text.

The macro is working but :

• I want each file to be in a row (this macro display them in column)

This excel will them by export as .csv to be imported in my joomla website with MySql

Thanks a lot for your help!

解决方案

Instead of using Excel to do the dirty work, I would recommend using Arrays to perform the entire operation. The below code took 1 sec to process 300 files

LOGIC:

1. Loop through the directory which has text files
2. Open the file and read it in one go into an array and then close the file.
3. Store the results in a temp array
4. When all data is read, simply output the array to Excel Sheet

CODE: (Tried and tested)

'~~> Change path here
Const sPath As String = "C:\Users\Siddharth Rout\Desktop\DeleteMelater\"

Sub Sample()
    Dim wb As Workbook
    Dim ws As Worksheet

    Dim MyData As String, tmpData() As String, strData() As String
    Dim strFileName As String

    '~~> Your requirement is of 267 files of 1 line each but I created 
    '~~> an array big enough to to handle 1000 files
    Dim ResultArray(1000, 3) As String

    Dim i As Long, n As Long

    Debug.Print "Process Started At : " & Now

    n = 1

    Set wb = ThisWorkbook

    '~~> Change this to the relevant sheet
    Set ws = wb.Sheets("Sheet1")

    strFileName = Dir(sPath & "\*.txt")

    '~~> Loop through folder to get the text files
    Do While Len(strFileName) > 0

        '~~> open the file in one go and read it into an array
        Open sPath & "\" & strFileName For Binary As #1
        MyData = Space$(LOF(1))
        Get #1, , MyData
        Close #1
        strData() = Split(MyData, vbCrLf)

        '~~> Collect the info in result array
        For i = LBound(strData) To UBound(strData)
            If Len(Trim(strData(i))) <> 0 Then
                tmpData = Split(strData(i), ",")

                ResultArray(n, 0) = Replace(tmpData(0), Chr(34), "")
                ResultArray(n, 1) = Replace(tmpData(1), Chr(34), "")
                ResultArray(n, 2) = Replace(tmpData(2), Chr(34), "")
                ResultArray(n, 3) = Replace(tmpData(3), Chr(34), "")

                n = n + 1
            End If
        Next i

        '~~> Get next file
        strFileName = Dir
    Loop

    '~~> Write the array to the Excel Sheet
    ws.Range("A1").Resize(UBound(ResultArray), _
    UBound(Application.Transpose(ResultArray))) = ResultArray

    Debug.Print "Process ended At : " & Now
End Sub

这篇关于立即将100个文本文件导入Excel的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！