ファイル名をシートに張り付けるには？

質問

今朝、質問し、ご回答をいただいたのですが、
それを試してみても、うまく動いてくれません・・・。

下記を用いて、ダイアログから選択したテキストファイル
をシートに張り付けていくよう（外部データのインポート）に
マクロを組んだんですけど、これを利用して、ついでにその選んだ
テキストファイル名（拡張子なし）を
任意のセル（たとえばＤ２）に張り付けるにはどうしたらいいんでしょか？
当方、エクセル2000です。
Application.ScreenUpdatingやGetBaseNameを使っても
うまくいきません。

Sub Macro1()

fileToOpen = Application _
.GetOpenFilename("テキストファイル (*.txt), *.txt")
If fileToOpen <> False Then

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fileToOpen, Destination:=Range("B11"))

回答No.1

mach999 · ベストアンサー

単純にひとつのファイルバージョン。FileSystemObjectが使えない可能性も考えられたので，自作のGetBaseName付き（拡張子は確定しているので簡単に処理しています）。FileSystemObjectが問題なく使用できる環境であればFileSystemObjectのGetBaseNameに置き換えてください。

Sub AskFileToOpen()
　　Dim FileToOpen As String

　　FileToOpen = Application.GetOpenFilename("テキストファイル (*.txt), *.txt")

　　If FileToOpen <> "False" Then
　　　　Range("D2").Value = GetBaseName(FileToOpen)
　　End If
End Sub

Function GetBaseName(PathName As String) As String
　　Dim PathArray() As String
　　Dim FileName As String

　　PathArray = Split(PathName, "\", , vbTextCompare)
　　FileName = PathArray(UBound(PathArray))

　　GetBaseName = Left(FileName, Len(FileName) - Len(".txt"))
End Function

Excel2003で動作確認済みです。たぶん2000でも大丈夫だとは思いますが…。

お礼

どうもありがとうございます。

回答No.2

misatoanna

テキストをインポートすると、その範囲に元ファイル名と同じ名前がつけられます
ので、次のようにするのはいかがでしょうか。
インポートして貼り付ける部分はマクロ化していませんが。

Sub Test()
Dim myName As String
On Error Resume Next
Names(1).Delete
Application.Dialogs(xlDialogImportTextFile).Show
myName = Right(Names(1).Name, Len(Names(1).Name) - InStr(Names(1).Name, "!"))
Range("A2") = myName
End Sub

意味を取り違えていたら、ごめんなさい。

お礼

どうもありがとうございます。