我有一个小工具，是选取某一个文件夹后，处理该文件夹下所有的数据后，自动生成一个文件并且在里面输出结果，我现在想让该输出的文件的文件名自动变为刚刚选取的上层文件夹的文件名，请问各位大神，代码怎么写？（附已完成的代码）
Private Sub Command1_Click()
Dim a(1048576) As String   
Dim aa(1048576) As String   
Dim aaa(1048576) As String   
Label4.Visible = True   '显示“正在处理，请耐心等待”
DoEvents   
sosuofile Text1.Text   

n = 0
p = 0

For m = 0 To List1.ListCount - 1

j = 0
k = 0

If LCase$(Right(List1.List(m), 3)) = "txt" Then

    Open List1.List(m) For Input As #1  
        Do While Not EOF(1)
        Line Input #1, temp
        
        If temp <> "" Then
            If Left(temp, 1) <> "-" Then  
                If j >= 2 Then
                    aa(j) = Split(temp, " ")(0)
                    temp1 = aa(j)
                    'If aa(j) - aa(j - 1) <> 1 Then
                        a(k) = temp
                        k = k + 1
                        j = j + 1
                    'End If
                Else
                    a(k) = temp
                    aa(j) = Split(temp, " ")(0)
                j = j + 1
                k = k + 1
                End If
            
            'MsgBox "当前数字＝" & temp1
            Else

            If temp1 = "" Then temp1 = "0000"
            
            If Mid(temp1, 1, 2) = "23" And Mid(temp1, 3, 2) = "59" Then
            aaa(p) = "0000"
            End If
            
            If Mid(temp1, 1, 2) <> "23" And Mid(temp1, 3, 2) = "59" Then
            aaa(p) = Format(CInt(Mid(temp1, 1, 2)) + 1, "00") & "00"
            End If
            
            If Mid(temp1, 1, 2) <> "23" And Mid(temp1, 3, 2) <> "59" Then
            aaa(p) = Format(CInt(Mid(temp1, 1, 2)), "00") & Format(CInt(Mid(temp1, 3, 2)) + 1, "00")
            
            'MsgBox aaa(p)
            End If
            
            If Mid(temp1, 1, 2) = "23" And Mid(temp1, 3, 2) <> "59" Then
            aaa(p) = Format(CInt(Mid(temp1, 1, 2)), "00") & Format(CInt(Mid(temp1, 3, 2)) + 1, "00")
            'MsgBox aaa(p)
            End If


            temp1 = aaa(p)
            p = p + 1
            
            
            End If
        End If
        
        Loop
    Close #1
   
    i = p - 1
   
    temp2 = List1.List(m)
   
        Open Mid(List1.List(m), 1, Len(List1.List(m)) - 4) & ".bak" For Output As #1   
            For j = 0 To i
                'If Round(TimeValue(Format(Mid(aa(j), 1, 2) & ":" & Mid(aa(j), 3, 2) & ":00", "hh:mm:ss")) - TimeValue(Format(Mid(aa(j - 1), 1, 2) & ":" & Mid(aa(j - 1), 3, 2) & ":00", "hh:mm:ss")), 12) <> 0.000694444444 _
                'And Round(TimeValue(Format(Mid(aa(j), 1, 2) & ":" & Mid(aa(j), 3, 2) & ":00", "hh:mm:ss")) - TimeValue(Format(Mid(aa(j - 1), 1, 2) & ":" & Mid(aa(j - 1), 3, 2) & ":00", "hh:mm:ss")), 12) <> -0.999305555556 Then  
                If aaa(j) <> "" Then
                Print #1, aaa(j)
                                
                Open App.Path & "\缺测总数.bak" For Append As #2
               
                If temp2 = List1.List(m) Then
                Print #2, temp2
                temp2 = ""
                End If
               
                Print #2, aaa(j)
               
                Close #2
               
                aaa(j) = ""   '清空原数组的值
                n = n + 1
                End If
            Next j
        Close #1

End If

Next m

Open App.Path & "\缺测总数.bak" For Append As #2
Print #2, "缺测总数:" & n
Close #2

Label4.Visible = False  '重新隐藏“正在处理，请耐心等待”
MsgBox "ok", 64, "恭喜" '提示完成
End Sub

Private Sub sosuofile(mypath As String)
Dim myname As String
Dim a As String
Dim b() As String
Dim dir_i() As String
Dim i, idir As Long
If Right(mypath, 1) <> "\" Then mypath = mypath + "\"
myname = Dir(mypath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly)
Do While myname <> ""
If myname <> "." And myname <> ".." Then
If (GetAttr(mypath & myname) And vbDirectory) = vbDirectory Then
idir = idir + 1
ReDim Preserve dir_i(idir) As String
dir_i(idir - 1) = myname
Else
List1.AddItem mypath & myname
End If
End If
myname = Dir
Loop
For i = 0 To idir - 1
Call sosuofile(mypath + dir_i(i))
Next i
ReDim dir_i(0) As String
End Sub

顶贴

写成函数形式，在需要的地方再调用:

Function GetFileNames(ByVal bPath As String) As String
    If Right$(bPath, 1) <> "\" Then bPath = bPath & "\"
    Dim w1 As String, ww
    ww = Split(bPath, "\")
    w1 = ww(UBound(ww) - 1)
    If Right$(w1, 1) = ":" Then w1 = Replace(w1, ":", "") ''根目录
    GetFileNames = bPath & w1 & ".txt" ''这个是文件名的完整路径
End Function

调用方法：

Open GetFileNames(MyPath) For Output As #1

写成函数形式，在需要的地方再调用:

Function GetFileNames(ByVal bPath As String) As String
    If Right$(bPath, 1) <> "\" Then bPath = bPath & "\"
    Dim w1 As String, ww
    ww = Split(bPath, "\")
    w1 = ww(UBound(ww) - 1)
    If Right$(w1, 1) = ":" Then w1 = Replace(w1, ":", "") ''根目录
    GetFileNames = bPath & w1 & ".txt" ''这个是文件名的完整路径
End Function

调用方法：

Open GetFileNames(MyPath) For Output As #1