Question

我在一个文件夹中有6个文本文件。

我希望使用访问权限将所选文件合并到一个文本中。

我尝试过这段代码没有成功，因为创建了一个文本文件但是为空

任何人都可以帮我吗？

提前致谢，我的代码如下。

文本文件中的行：

xN;xDate;xNode;xCO;
100;2017-09-26 00:00:00;Valley;D6;
101;2017-09-25 00:00:00;Valley;D3;
...
...

代码：

Dim xPath
Function xExtract()
    Dim xArray() As Variant
    Dim I As Integer
    Dim StrFileName As String

    xPath = CurrentProject.Path

PDS:
xArray = Array("D1", "D2", "D3", "D4", "D5", "D6")

                     new_file = "" & xPath & "\PDS.txt"

                     fn = FreeFile
                     Open new_file For Output As fn
                     Close
                     For I = 0 To UBound(xArray)

                     StrFileName = "\\myserver\inetpub\ftproot\PDS_" & xArray(I) & ".txt"

                      fn = FreeFile
                      Open StrFileName For Input As fn
                      Open new_file For Append As fn + 1

                      Line Input #fn, dato

                      Do While Not EOF(fn)
                        Line Input #fn, dato
                        dati = Split(dato, Chr(9))
                        For d = 0 To UBound(dati)
                            If d = 0 Then
                                dato = Trim(dati(d))
                            Else
                                dato = dato & ";" & Trim(dati(d))
                            End If
                        Next

                        Print #fn + 1, dato

                      Loop
                      Close
                     Next I   

    Application.Quit
End Function

Answer 1

由于您的代码适用于具有Windows EOL格式（CR（回车）+ LF（换行））的文件，我猜您的文件是UNIX EOL格式（只是LF，没有CR），请与texteditor一起检查，例如： Notepad ++（查看 - ＆gt;显示符号 - ＆gt;显示行尾）。这会导致Line Input在CR中断时读取整行文件。然后跳过第一行并且没有插入任何内容，因为所有文本都在此行中。

您可以使用FileSystemObject来避免这种情况，因为它会在LF上中断。

Function xExtract()

Const ForReading = 1, ForWriting = 2, ForAppending = 8 'iomode constants
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0 'format constants
Dim xArray As Variant, dati As Variant
Dim i As Long, d As Long
Dim xPath As String, new_file As String, dato As String, StrFileName As String
Dim FSO As Object, TextStreamIn As Object, TextStreamOut As Object


xPath = CurrentProject.Path
new_file = xPath & "\PDS.txt"

xArray = Array("D1", "D2", "D3", "D4", "D5", "D6")


Set FSO = CreateObject("Scripting.FileSystemObject")

Set TextStreamOut = FSO.OpenTextFile(new_file, ForWriting, True, TristateUseDefault) 'open textstream to write

For i = 0 To UBound(xArray) 'loop through files
    StrFileName = "\\myserver\inetpub\ftproot\PDS_" & xArray(i) & ".txt"

    Set TextStreamIn = FSO.OpenTextFile(StrFileName, ForReading) ' open textstream to read

    TextStreamIn.SkipLine 'skip first line with headers

    Do Until TextStreamIn.AtEndOfStream 'loop through lines
        dati = Split(TextStreamIn.Readline, Chr(9))
        For d = 0 To UBound(dati)
            If d = 0 Then
                dato = Trim(dati(d))
            Else
                dato = dato & ";" & Trim(dati(d))
            End If
        Next
        TextStreamOut.WriteLine dato 'write line to file
    Loop
    TextStreamIn.Close 'close textstream
Next i 'next file

TextStreamOut.Close
Set TextStreamOut = Nothing
Set TextStreamIn = Nothing
Set FSO = Nothing

Application.Quit
End Function

如果你想留在Open file你可以拆分LF（Split(dato,vbLf）上的第一行（也是唯一一行）并忽略第一个元素，但你必须检查文件是否为UNIX EOL格式，FSO涵盖了两者。

Answer 2

这是用于连接逗号分隔文本文件的代码（可能适用于任何文本文件）。相当粗糙。需要错误处理程序，并将受益于通用对话框来选择输出文件夹和文件名。此外，我不喜欢使用非类型化变量，但我不知道其中一些是什么类型的对象，并且无法从 Microsoft 帮助中弄清楚。警告，不要将输出放在同一个文件夹中 - 可能会导致无限循环 - 相信我，我试过了

Public Function CFiles(Filepath As String) As String

    Dim FSO As Scripting.FileSystemObject
    Dim SourceFolder As Folder
    Dim Filein As Object
    Dim fileout As Object
    Dim strText As String
    Dim TheInputfile As Object
    Dim filename As String

    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(Filepath)
 
    Set fileout = FSO.CreateTextFile("c:\InvestmentsPersonal\files\backup\output.txt", ForAppending, False)

    
    For Each Filein In SourceFolder.Files
        filename = Filein.Name
        Set TheInputfile = FSO.OpenTextFile(Filepath & filename, ForReading)
        strText = TheInputfile.ReadAll
        TheInputfile.Close
        fileout.WriteLine strText
    Next
    
    fileout.Close
    Set fileout = Nothing
    
    Set Filein = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    CFiles = "c:\InvestmentsPersonal\files\backup\output.txt"

End Function

使用ms访问将多个文件合并到一个文本中

2 个答案: