Question

以下vba将解析后的输出保存在工作簿中，而不是myDir xlsx目录中，我似乎无法弄明白。它似乎除了那个功能，我需要一些专家帮助确定最后一部分。基本上，解析txt中的每个myDir文件，然后用解析的txt替换xlsx文件。目前，正在发生的事情是txt中的第一个myDir文件正在解析并保存在工作簿中，然后vba退出。

编辑下面的vba运行但在工作簿的工作表中显示已解析的输出，而不是在myDir中保存为xlsx。

`ActiveWorkbook.SaveAs Filename:=Replace(fn, ".txt", ""), FileFormat:=xlOpenXMLWorkbook' 
stepping-through the vba I can see that fn has the full path and the filename but not sure why it does not save to myDir as an xlsx.

VBA

 Option Explicit 
 Private Sub CommandButton21_Click() 
 Dim myDir As String, fn As String 
 myDir = "C:\Users\cmccabe\Desktop\EmArray\" 
 fn = Dir(myDir & "*.txt") 
 Do While fn <> "" 
    CreateXLSXFiles myDir & fn 
    fn = myDir 
 Loop 
 End Sub 
 Sub CreateXLSXFiles(fn As String) 
 Dim txt As String, m As Object, n As Long, myDir As String 
 Dim i As Long, x, temp, ub As Long, myList 
 myList = Array("Display Name", "Medical Record", "Date of Birth", "Order Date", _ 
"Gender", "Barcode", "Sample", "Build", "SpikeIn", "Location", "Control Gender", "Quality") 
myDir = "C:\Users\cmccabe\Desktop\EmArray\" 
Sheets(1).Cells.Clear 
Sheets(1).Name = CreateObject("Scripting.FileSystemObject").GetBaseName(myDir & fn) 
On Error Resume Next 
n = FileLen(fn) 
If Err Then 
    MsgBox "Something wrong with " & fn 
    Exit Sub 
End If 
On Error GoTo 0 
n = 0 
txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll 
With CreateObject("VBScript.RegExp") 
    .Global = True: .MultiLine = True 
    For i = 0 To UBound(myList) 
        .Pattern = "^#(" & myList(i) & " = (.*))" 
        If .test(txt) Then 
            n = n + 1 
            Sheets(1).Cells(n, 1).Resize(, 2).Value = _ 
            Array(.Execute(txt)(0).submatches(0), .Execute(txt)(0).submatches(1)) 
        End If 
    Next 
    .Pattern = "^[^#\r\n](.*[\r\n]+.+)+" 
    x = Split(.Execute(txt)(0), vbCrLf) 
    .Pattern = "(\t| {2,})" 
    temp = Split(.Replace(x(0), Chr(2)), Chr(2)) 
    n = n + 1 
    For i = 0 To UBound(temp) 
        Sheets(1).Cells(n, i + 1).Value = temp(i) 
    Next 
    ub = UBound(temp) 
    .Pattern = "((\t| {2,})| (?=(\d|"")))" 
    For i = 1 To UBound(x) 
        temp = Split(.Replace(x(i), Chr(2)), Chr(2)) 
        n = n + 1 
        Sheets(1).Cells(n, 1).Resize(, ub).Value = temp 
    Next 
End With 
Sheets(1).Copy 
ActiveWorkbook.SaveAs Filename:=Replace(fn, ".txt", ""), FileFormat:=xlOpenXMLWorkbook 
ActiveWorkbook.Close False

End Sub

Answer 1

您正在将myDir & fn作为参数传递给 CreateXLSXFiles 过程。该过程中的参数称为fn。您无处在 CreateXLSXFiles 过程中声明或分配myDir变量。

最佳实践＆＃39;可能是完全删除扩展名并允许Workbook.SaveAs method的 FileFormat 参数通过适当的XlFileFormat Enumeration常量设置它。在这种情况下， xlOpenXMLWorkbook （例如 51 ）是合适的。

ActiveWorkbook.SaveAs Filename:=Replace(fn, ".txt", ""), FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close False

简而言之，您试图在另一个过程中使用在一个过程中声明和分配的变量。使用模块代码表顶部的Option Explicit来避免这些类型的错误，或使用VBE的工具，选项，编辑器，需求变量声明。如果您设置FileFormat和该参数来确定文件扩展名，那么您应该很好。

<强>附录：

我没有太多关注你的主要呼叫程序。仔细研究显示出一个离散但严重的缺陷。

 Private Sub CommandButton21_Click() 
     Dim myDir As String, fn As String 

     myDir = "C:\Users\cmccabe\Desktop\EmArray\" 
     fn = Dir(myDir & "*.txt") 
     Do While fn <> "" 
        CreateXLSXFiles myDir & fn 
        fn = Dir '<~~ get the next filename from DIR, not reassigned to myDir!!!
     Loop 

 End Sub

最初将 myDir 的价值重新分配给 fn 的方式并没有让你到任何地方。通过调试方法显示 fn 的新值，这应该是相当简单的。

全部放在一起

Private Sub CommandButton1_Click()
    Dim myDir As String, fn As String
    myDir = "C:\Users\cmccabe\Desktop\EmArray\"
    fn = Dir(myDir & "file*.txt")
    Do While fn <> ""
       CreateXLSXFiles myDir & fn
       fn = Dir
    Loop
 End Sub

 Sub CreateXLSXFiles(fn As String)
     Dim txt As String, m As Object, n As Long, fp As String
     Dim i As Long, x, temp, ub As Long, myList

     myList = Array("Display Name", "Medical Record", "Date of Birth", _
                    "Order Date", "Gender", "Barcode", "Sample", "Build", _
                    "SpikeIn", "Location", "Control Gender", "Quality")

    fp = "C:\Users\cmccabe\Desktop\EmArray\"

    With Worksheets(1)
        .Cells.Clear
        .Name = CreateObject("Scripting.FileSystemObject").GetBaseName(fn)

        'RegEx stuff going on here

        .Copy
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=fp & .Name, _
                              FileFormat:=xlOpenXMLWorkbook
        ActiveWorkbook.Close False
        Application.DisplayAlerts = True
    End With
End Sub

保存在工作簿中，而不是作为xlsx保存在目录中

1 个答案: