我想将一组文本文件导入到一个Excel文档中。我怎么做？

Question

我有一组txt文件，其中包含相同类型的数据，并在列的空格中分隔 我有大约500个这样的文件，我想将它们全部导入一个spredsheet。

有人可以告诉我该怎么做？

谢谢！

Answer 1

Sub DoIt（）

Dim iFileNum As Integer
Dim sDataLine As String
Dim sDir As String
Dim sFile As String
Dim iCnt As Integer
Dim iRow As Integer
Dim iCol As Integer
Dim iFnd As Integer
Dim iLen As Integer
Dim iFound(20) As Integer
Dim sRng As String
Dim sOut As String

' Change this to the directory with all the files in it
sDir = "c:\test\"

ChDrive "C" 'If this is on a network drive change this to the network drive letter
ChDir sDir
'This will read the 1st .txt file in the directory
sFile = Dir("*.txt")
iRow = 0
'This is will read all the files in the directory one at a time
Do While sFile <> ""
    iFileNum = FreeFile()
    Open sFile For Input As #iFileNum ' this opens the file
    While Not EOF(iFileNum)
        iRow = iRow + 1
        Line Input #iFileNum, sDataLine
        iLen = Len(sDataLine)
        iCnt = 0
        ' This locates the spaces in your string
        For b = 1 To iLen
            If Mid(sDataLine, b, 1) = " " Then
                iCnt = iCnt + 1
                iFound(iCnt) = b
            End If
        Next
        iCol = 65 'Chr(65)  is A
        sRng = Chr(iCol) & iRow
        sOut = Mid(sDataLine, 1, iFound(1) - 1)
        'if you want 0000 to show as a number and not text use the next line
        'ActiveSheet.Range(sRng) = sOut
        'Otherwise it will put it as a text
        ActiveSheet.Range(sRng) = "'" & sOut
        iCol = iCol + 1
        For b = 1 To iCnt - 1
            sRng = Chr(iCol) & iRow
            sOut = Mid(sDataLine, iFound(b) + 1, iFound(b + 1) - iFound(b) - 1)
            'Same here
            ActiveSheet.Range(sRng) = "'" & sOut
            iCol = iCol + 1
        Next
    Wend
    sFile = Dir
Loop

End Sub