如何删除使用vba excel宏创建的多余空文本文件，其文件名是单元格中的单元格？

Question

我只是使用excel vba宏而已。我正在尝试创建文本文件并将单元格值用作单个文本文件的名称。首先，该值包含字符，这些字符将被替换。唯一的价值将是所有的数字。该功能运行良好。我的问题是一旦我执行创建按钮，程序将创建一个额外的文本文件，该文件的名称基于空单元格，并且在文本文件中没有任何输入“D”作为输入。我想要的是创建一个没有创建额外文本文件的文本文件。下面是我的excel格式和代码。

我有如下3列使用：

 
LOG DATA INPUT BLOCK NAME 
5687 D ASD 
5689 D 
5690 D 
5692 D 
5691 D 
5688 D 
4635 D 

正确的结果将创建四个文本文件：

 
abc-5687.req 
abc-5689.req 
abc-5690.req 
abc-5692.req 

结果有额外的文本文件，认为是错见下文：

abc-.req <-- extra text file created 
abc-5687.req 
abc-5689.req 
abc-5690.req 
abc-5692.req 

我的代码：

Private Sub CREATE_REQ_Click() 
    Dim myDataSheet As Worksheet 
    Dim myReplaceSheet As Worksheet 
    Dim myLastRow As Long 
    Dim myRow As Long 
    Dim myFind As String 
    Dim myReplace1 As String 
    Dim myReplace2 As String 
    Dim sExportFolder, sFN 
    Dim rArticleName As Range 
    Dim rDisclaimer As Range 
    Dim oSh As Worksheet 
    Dim oFS As Object 
    Dim oTxt As Object 

' Specify name of Data sheet 
    Set myDataSheet = Sheets("Sheet1") 

' Specify name of Sheet with list of replacements 
    Set myReplaceSheet = Sheets("Sheet2") 

' Assuming list of replacement start in column A on row 2, find last entry in list 
    myLastRow = myReplaceSheet.Cells(Rows.Count, "A").End(xlUp).Row 

    Application.ScreenUpdating = False 

' Loop through all list of replacments 
    For myRow = 2 To myLastRow 
'  Get find and replace values (from columns A and B) 
     myFind = myReplaceSheet.Cells(myRow, "A") 
     myReplace1 = myReplaceSheet.Cells(myRow, "B") 
'  Start at top of data sheet and do replacements 
     myDataSheet.Activate 
     Range("A2").Select 
'  Ignore errors that result from finding no matches 
     On Error Resume Next 
'  Do all replacements on column A of data sheet 
     Columns("A:A").Replace What:=myFind, Replacement:=myReplace1, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False 
    Next myRow 

    sExportFolder = "D:\TEST\REQ_FILES_CREATED_HERE" 
    Set oSh = Sheet1 
    Set oFS = CreateObject("Scripting.Filesystemobject") 

    For Each rArticleName In oSh.UsedRange.Columns("A").Cells 
     Set rDisclaimer = rArticleName.Offset(, 1) 
     If rArticleName = "" & "LOG DATA" Then 
      oTxt = False 
     Else 
      'Add .txt to the article name as a file name 
      sFN = "-" & rArticleName.Value & ".req" 
      Set oTxt = oFS.OpenTextFile(sExportFolder & "\" & ActiveSheet.Cells(2, 3) & sFN, 2, True) 

      oTxt.Write rDisclaimer.Value 
      oTxt.Close 
     End If 
    Next 

    'Reset error checking 
    On Error GoTo 0 
    Application.ScreenUpdating = True 

    MsgBox "Replacements complete! " 
End Sub 

Answer 1

For Each rArticleName In oSh.UsedRange.Columns("A").Cells 
    Set rDisclaimer = rArticleName.Offset(, 1) 
    If Not(rArticleName = "" Or rArticleName = "LOG DATA") Then 
     'Add .txt to the article name as a file name 
     sFN = "-" & rArticleName.Value & ".req" 
     Set oTxt = oFS.OpenTextFile(sExportFolder & "\" & ActiveSheet.Cells(2, 3) & sFN, 2, True) 
     oTxt.Write rDisclaimer.Value 
     oTxt.Close 
    End If 
Next 

非常接近一行修正。你只需要修复If。一旦这是正确的，你不需要Else。