excel 生成.txt文件时防止添加额外行的VBA代码

wnavrhmk  于 2023-05-19  发布在  其他
关注(0)|答案(1)|浏览(100)

下面的代码是:

Sub GenerateTxtFile()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim filePath As String
    Dim txtData As String
    
    Set ws = ActiveSheet ' Change to the specific worksheet if needed
    
    ' Get the path of the Excel file
    filePath = ThisWorkbook.Path & "\RxH.txt"
    
    With ws
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        ' Loop through each row and construct the TXT data
        For i = 2 To lastRow ' Start from row 2 to skip the headings row
            Dim invoiceNo As String
            invoiceNo = .Cells(i, "C").Value
            Dim dashIndex As Long
            dashIndex = InStr(1, invoiceNo, "-")
            
            txtData = txtData & _
                Replace(.Cells(i, "A").Value, ",", "") & "|" & _
                "R1" & "|" & _
                Left(invoiceNo, dashIndex - 1) & "|" & _
                Mid(invoiceNo, dashIndex + 1) & "|" & _
                Format(.Cells(i, "B").Value, "dd/mm/yyyy") & "|" & _
                Replace(.Cells(i, "D").Value, ",", "") & vbCrLf ' vbCrLf adds a new line
        Next i
    End With
    
    ' Write the TXT data to a file
    Open filePath For Output As #1
    Print #1, Mid(txtData, 1, Len(txtData) - 2) ' Exclude the last vbCrLf
    Close #1
    
    MsgBox "TXT file generated successfully!", vbInformation
End Sub

问题是它生成的.txt文件底部多了一行,而我上传txt文件的系统无法处理它。有没有一种方法可以生成txt文件而不需要额外的一行?谢谢!
我期待的.txt文件生成没有一个额外的行在结束。

4sup72z8

4sup72z81#

尝试此更新的代码,其中添加了一个检查,以在添加vbCrLf之前验证它是否是范围的最后一行。

Sub GenerateTxtFile()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim filePath As String
    Dim txtData As String

    Set ws = ActiveSheet ' Switch to the specific sheet if necessary

    ' Gets the path to the Excel file
    filePath = ThisWorkbook.Path & "\RxH.txt"

    With ws
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        ' Iterate through each row and build the TXT data
        
        For i = 2 To lastRow ' Start from row 2 to skip the row of headers
            Dim invoiceNo As String
            invoiceNo = .Cells(i, "C").Value
            Dim dashIndex As Long
            dashIndex = InStr(1, invoiceNo, "-")

            txtData = txtData & _
                Replace(.Cells(i, "A").Value, ",", "") & "|" & _
                "R1" & "|" & _
                Left(invoiceNo, dashIndex - 1) & "|" & _
                Mid(invoiceNo, dashIndex + 1) & "|" & _
                Format(.Cells(i, "B").Value, "dd/mm/yyyy") & "|" & _
                Replace(.Cells(i, "D").Value, ",", "")

            ' Adds a new line only if it is not the last row
            
            If i < lastRow Then
                txtData = txtData & vbCrLf ' vbCrLf add a new line
            End If
        Next i
    End With

    ' Writes TXT data to a file
    Open filePath For Output As #1
    Print #1, txtData ' Excludes the last extra line
    Close #1

    MsgBox "TXT file generated successfully!", vbInformation
End Sub

相关问题