エクセルでファイル名を任意のセルに入力するマクロを組むには？

質問

エクセルにて、マクロを実行すると、
ダイアログボックスが出てきて、ファイルを
選ぶと、そのファイル名が任意のセル
（たとえばＢ１０とか）に入力されるような
マクロを組みたいのですが、うまくいきません。
しかも、そのファイル名についている拡張子なしで
入力されるようにしたいです。
どなたかご教授ください。

回答No.3

imogasi

Sub teat02()
ofilenam = Application _
.GetOpenFilename("すべての ファイル (*.txt), *.txt")
If ofilenam <> False Then
s = Dir(ofilenam)
p = Split(s, ".")
Range("B10") = p(0)
End If
End Sub
＃１、＃２のご解答より厳密性に欠けるかも知れませんが。

回答No.2

papayuka

#1です。

上手くいかなかったのは私が作ったサンプルが上手く動かなかったって事でしょうか？

それとも組み込み方が良く解らないって事？
もしそうなら、

'これをモジュールにコピペして
Function myExt(ByVal s As String)
Dim i As Integer
　myExt = s
　For i = Len(s) To 1 Step -1
　　If Mid(s, i, 1) = "." Then
　　　 myExt = Mid(s, 1, i - 1)
　　　 Exit For
　　End If
　Next i
End Function

Sub Macro1()
fileToOpen = Application _
.GetOpenFilename("すべての ファイル (*.txt), *.txt")
　If fileToOpen <> False Then

　　'↓これを入れる
　　Range("A1").Value = myExt(Dir(fileToOpen))

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

回答No.1

papayuka

サンプルを書いた環境(Win95+Excel97)では FileSystemObject が使えなかったので、拡張子を削る関数を入れてます。
FileSystemObject が使えれば GetBaseName が使えます。

Sub Test()
Dim myfiles
　myfiles = Application.GetOpenFilename(MultiSelect:=True)
　If Not IsArray(myfiles) Then Exit Sub
　For i = 1 To UBound(myfiles)
　　ActiveCell.Offset(i - 1, 0).Value = myExt(Dir(myfiles(i), vbHidden + vbSystem))
　　ActiveCell.Offset(i - 1, 1).Value = Dir(myfiles(i), vbHidden + vbSystem)
　　ActiveCell.Offset(i - 1, 2).Value = myfiles(i)
　Next i
End Sub

Function myExt(ByVal s As String)
Dim i As Integer
　myExt = s
　For i = Len(s) To 1 Step -1
　　If Mid(s, i, 1) = "." Then
　　　 myExt = Mid(s, 1, i - 1)
　　　 Exit For
　　End If
　Next i
End Function

お礼

とりあえず、やってみます。
どうもありがとうございました。

補足

papayuka様からいただいた回答を組み込んで
みたのですが、うまくいきませんでした。
いろいろといじってみたのですが・・・。
当方のエクセルは2000です。

下記を用いて、ダイアログから選んだテキストファイル
（外部データのインポート）を各セルに張り付けて
いくようにマクロを組んだんですけど、これを利用して、ついでにその選んだテキストファイル名（拡張子なし）を
任意のセルに張り付けるにはどうしたらいいんでしょか？

Sub Macro1()

fileToOpen = Application _
.GetOpenFilename("すべての ファイル (*.txt), *.txt")
If fileToOpen <> False Then
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fileToOpen, Destination:=Range("B11"))