Saving in workbook not in directory as xlsx

Question

The below vba saves the parsed output in the workbook not in the myDir directory as an xlsx and I can not seem to figure it out. It seems to function except for that and I need some expert help figuring the last part out. Basically, each txt file in the myDir is parsed and then the txt file is replaced with the parsed xlsx. Currently, what is happening is the first txt file in myDir is being parsed and saved in the workbook then the vba exits.

edit the vba below runs but displays the parsed output in the sheet of the workbook and not saved as an xlsx in the myDir.

`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

You are passing in myDir & fn as a parameter to the CreateXLSXFiles procedure. The parameter is called fn in that procedure. Nowhere do you declare or assign a myDir variable in the CreateXLSXFiles procedure.

The 'best practice' might be to remove the extension altogether and allow the FileFormat parameter of the Workbook.SaveAs method to set it through the appropriate XlFileFormat Enumeration constant. In this case, xlOpenXMLWorkbook (e.g. 51) would be appropriate.

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

In short, you are trying to use a variable declared and assigned in one procedure in another procedure. Use Option Explicit at the top of your module code sheet to avoid these types of errors or use the VBE's Tools, Options, Editor, Require Variable Declaration. If you set the FileFormat and that parameter to determine the file extension, you should be good.

Addendum:

I hadn't given much attention to your primary calling procedure. A closer examination showed a discrete but critical flaw.

 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 

The way it was originally reassigning the value of myDir to fn wasn't going to get you anywhere. That should have been fairly straightforward with debugging methods revealing the new value of fn.

Put All Together

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