ジャンク①ファイル名取得

Sub ExtractFileNamesAndSaveAsText()
    Dim dialog As FileDialog
    Dim fileName As Variant
    Dim outputPath As String
    Dim outputFile As Integer
    Dim wb As Workbook
    Dim ws As Worksheet
    
    ' ダイアログを表示して複数のファイルを選択する
    Set dialog = Application.FileDialog(msoFileDialogOpen)
    dialog.AllowMultiSelect = True
    dialog.title = "Excelファイルを選択してください"
    If dialog.Show = -1 Then
        ' 出力先フォルダを指定
        outputPath = "C:\Users\user\Desktop\memoファルダ\Dim myRng As Range.txt"
        ' テキストファイルを作成
        outputFile = FreeFile
        Open outputPath & "ファイル名.txt" For Output As #outputFile
        
        ' 選択されたファイルのファイル名をテキストファイルに書き出す
        For Each fileName In dialog.SelectedItems
            Set wb = Workbooks.Open(fileName)
            Set ws = wb.Sheets(1)
            Print #outputFile, ExtractFileName(ws.Range("A1").Value) ' 適切なセル範囲を指定
            wb.Close False
        Next fileName
        
        ' テキストファイルを閉じる
        Close #outputFile
        
        MsgBox "ファイル名が保存されました。"
    Else
        MsgBox "キャンセルされました。"
    End If
End Sub

Function ExtractFileName(fullName As String) As String
    ' ファイル名をアンダースコア(_)までの部分だけ抽出する
    Dim pos As Integer
    pos = InStr(fullName, "_")
    If pos > 0 Then
        ExtractFileName = Left(fullName, pos - 1)
    Else
        ExtractFileName = fullName
    End If
End Function