Excel VBA生成文本文件问题：借贷不等时仍生成空文件

原代码的核心问题是还未完成借贷总金额校验，就提前执行了文件创建操作，导致即便后续校验不通过，空文件依然会留在目录中。要实现"借贷不等则不生成任何文件"的需求，可通过以下两种方式修改：

方案一：先校验借贷总额，再创建文件（推荐） #

先遍历计算借贷总金额，确认相等后再创建文件并写入内容，从根源避免空文件生成：

Option Explicit
Dim rowcount As Long                    '记录行数
Dim counter As Long                     '循环计数器
Dim sim_line As String             '待写入文本行
Dim filenum As Integer                  '可用文件编号
Dim filename As String
Dim cr As Double                       '金额改用Double，避免小数精度丢失
Dim dr As Double

Private Sub cmdok_Click()
    rowcount = Sheet1.no_of_rows

    If Trim(txtfilename.Text) = "" Then
        MsgBox "文件名不能为空", vbCritical
        GoTo Trap
    End If
    filename = Trim(txtfilename.Text)

    Application.ScreenUpdating = False

    '先遍历计算借贷总金额
    cr = 0
    dr = 0
    For counter = 2 To rowcount
        If UCase(Trim(Range("B" & counter).Value)) = "C" Then
            cr = cr + Range("C" & counter).Value
        Else
            dr = dr + Range("C" & counter).Value
        End If
    Next counter

    '校验借贷总额是否相等
    If cr <> dr Then
        MsgBox "贷方总金额为 " & cr & "，借方总金额为 " & dr & "，两者不相等", vbCritical
        GoTo Trap
    End If

    '校验通过后，再创建目录和文件
    If Dir("C:\transfer\", vbDirectory) = "" Then MkDir "C:\transfer"

    filenum = FreeFile
    Open "C:\transfer\" & filename For Output As #filenum
        For counter = 2 To rowcount
            sim_line = ""
            sim_line = sim_line & Left(Trim(Range("A" & counter).Value) & Space(16), 16)
            sim_line = sim_line & "INR"
            sim_line = sim_line & Left(UCase(Trim(Range("B" & counter).Value)) & Space(1), 1)
                         
            Range("C" & counter).NumberFormat = "0.00"
            sim_line = sim_line & Right(Space(17) & Trim(Range("C" & counter).Text), 17)
            
            Print #filenum, sim_line
        Next counter
    Close #filenum
    
    MsgBox "TTUM上传文件已成功生成，文件名：" & filename & "，路径：C:\transfer" 
    Unload Me

Trap:
    Application.ScreenUpdating = True
End Sub

关键改动说明： #

1. 将cr和dr的类型从Long改为Double，避免处理带小数的金额时丢失精度
2. 提前遍历计算借贷总金额，完成校验后再执行文件创建和写入操作
3. 删除原代码中提前创建空文件的冗余步骤

方案二：保留原遍历逻辑，校验不通过时删除文件 #

如果需要保留先写入内容再校验的逻辑，可在校验不通过时删除已创建的文件：

Option Explicit
Dim rowcount As Long                    '记录行数
Dim counter As Long                     '循环计数器
Dim sim_line As String             '待写入文本行
Dim filenum As Integer                  '可用文件编号
Dim filename As String
Dim cr As Double
Dim dr As Double

Private Sub cmdok_Click()
    rowcount = Sheet1.no_of_rows

    If Trim(txtfilename.Text) = "" Then
        MsgBox "文件名不能为空", vbCritical
        GoTo Trap
    End If
    filename = Trim(txtfilename.Text)

    Application.ScreenUpdating = False

    If Dir("C:\transfer\", vbDirectory) = "" Then MkDir "C:\transfer"

    filenum = FreeFile
    Open "C:\transfer\" & filename For Output As #filenum
    Close #filenum

    filenum = FreeFile
    Open "C:\transfer\" & filename For Append As #filenum
        cr = 0
        dr = 0
        For counter = 2 To rowcount
            sim_line = ""
            sim_line = sim_line & Left(Trim(Range("A" & counter).Value) & Space(16), 16)
            sim_line = sim_line & "INR"
            sim_line = sim_line & Left(UCase(Trim(Range("B" & counter).Value)) & Space(1), 1)
                         
            Range("C" & counter).NumberFormat = "0.00"
            sim_line = sim_line & Right(Space(17) & Trim(Range("C" & counter).Text), 17)
            
            If UCase(Trim(Range("B" & counter).Value)) = "C" Then
                cr = cr + Range("C" & counter).Value
            Else
                dr = dr + Range("C" & counter).Value
            End If
            Print #filenum, sim_line
        Next counter
    Close #filenum
     
    If cr <> dr Then
        MsgBox "贷方总金额为 " & cr & "，借方总金额为 " & dr & "，两者不相等", vbCritical
        '删除已生成的文件
        Kill "C:\transfer\" & filename
        GoTo Trap
    End If 
   
    MsgBox "TTUM上传文件已成功生成，文件名：" & filename & "，路径：C:\transfer" 
    Unload Me

Trap:
    Application.ScreenUpdating = True
End Sub

关键改动说明： #

1. 同样将金额类型改为Double以保证精度
2. 在校验不通过的分支中，添加Kill "C:\transfer\" & filename语句删除已创建的文件

内容的提问来源于stack exchange，提问作者Nads707