Vba 在工作簿中保存为xlsx，但不在目录中

下面的

vba

将工作簿中不在

myDir

目录下的解析输出保存为

xlsx

，我似乎无法理解。除此之外，它似乎还能正常工作，我需要一些专家帮助我弄清楚最后一部分。基本上，解析

myDir

中的每个

txt

文件，然后用解析的

xlsx

替换

txt

文件。目前，正在发生的是

myDir

中的第一个

txt

文件正在被解析并保存在工作簿中，然后

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 

选项显式
私有子命令按钮21_单击（）
Dim myDir作为字符串，fn作为字符串
myDir=“C:\Users\cmccabe\Desktop\EmArray\”
fn=Dir（myDir&“*.txt”）
当fn“”时执行
createxlsx文件myDir&fn
fn=myDir
环
端接头
子CreateXLSX文件（fn作为字符串）
Dim txt作为字符串，m作为对象，n作为长，myDir作为字符串
暗i为长，x为温度，ub为长，myList
myList=数组（“显示名称”、“病历”、“出生日期”、“订单日期”、\u
“性别”、“条形码”、“样品”、“构建”、“添加”、“位置”、“控制性别”、“质量”）
myDir=“C:\Users\cmccabe\Desktop\EmArray\”
第（1）页。单元格。清除
Sheets（1）.Name=CreateObject（“Scripting.FileSystemObject”）.GetBaseName（myDir&fn）
出错时继续下一步
n=文件长度（fn）
如果有错误，那么
MsgBox“有问题”&fn
出口接头
如果结束
错误转到0
n=0
txt=CreateObject（“Scripting.FileSystemObject”）.OpenTextFile（fn.ReadAll
使用CreateObject（“VBScript.RegExp”）
.Global=True:.多行=True
对于i=0到UBound（myList）
.Pattern=“^#（”和myList（i）和“=（*）”
如果.test（txt）那么
n=n+1
工作表（1）。单元格（n，1）。调整大小（，2）。值=\u
数组（.Execute（txt）（0）.submatches（0），.Execute（txt）（0）.submatches（1））
如果结束
下一个
.Pattern=“^[^\r\n]（.[\r\n]+。+）+”
x=拆分（.Execute（txt）（0），vbCrLf）
.Pattern=“（\t{2，}）”
温度=拆分（.Replace（x（0），Chr（2）），Chr（2））
n=n+1
对于i=0至UBound（温度）
表（1）.单元（n，i+1）.值=温度（i）
下一个
ub=UBound（温度）
.Pattern=“（\t |{2，}）|（？=（\d |”）”
对于i=1到UBound（x）
温度=拆分（.x（i），Chr（2）），Chr（2））
n=n+1
表（1）。单元格（n，1）。调整大小（，ub）。值=温度
下一个
以
第（1）页。复印件
ActiveWorkbook.SaveAs文件名：=替换（fn，.txt，“”），文件格式：=xlOpenXMLWorkbook
ActiveWorkbook.Close为False

---

End Sub

您正在将

myDir&fn

作为参数传递给CreateXLSXFiles过程。在该过程中，该参数称为

fn

。在CreateXLSXFiles过程中，没有任何地方可以声明或分配

myDir

变量

“最佳实践”可能是完全删除扩展名，并允许的FileFormat参数通过适当的常量进行设置。在这种情况下，xlOpenXMLWorkbook（例如51）是合适的

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

简言之，您正试图在一个过程中声明并分配一个变量，然后在另一个过程中使用该变量。使用模块代码表顶部的

Option Explicit

避免这些类型的错误，或者使用VBE的工具、选项、编辑器和Require变量声明。如果您设置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 

Private子命令按钮21_Click（）
Dim myDir作为字符串，fn作为字符串
myDir=“C:\Users\cmccabe\Desktop\EmArray\”
fn=Dir（myDir&“*.txt”）
当fn“”时执行
createxlsx文件myDir&fn
fn=Dir'是否将文件作为文本文件打开？如果是这样，那么当您
SaveAs
时，您需要包括文件类型enum。。。看起来您的MyDir存在范围问题。它在两个子系统中都是局部作用域。添加
Option Explicit
，您就会明白我的意思。进行更改后，我现在可以看到该文件正在被引用，但它仍然保存到工作簿中，而不是作为目录中的
xlsx
，这很奇怪。谢谢你给我的好提示：）。我道歉；我看不出您需要指定。请参阅上面的修改。我在
工作表（1）上获得了工作表错误的运行时无效名称。name=CreateObject（“Scripting.FileSystemObject”）。GetBaseName（fn）
。谢谢：）。由于目录
fn
=file1.txtfile2.txt中有两个文本文件，问题是
vba
无法正确读取单个文件吗？我用我遇到的问题更新了编辑，似乎无法解决。。。谢谢：）。请查看我在主要过程中发现的缺陷。
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