拡張子なしでファイル名を取得する

Windows7、EXCEL2013を使用しています。

VBAを使い、任意のフォルダを指定し、その中にあるファイル名を
・拡張子ありで取得するコマンドボタン(オブジェクト名：output)
・拡張子なしで取得するコマンドボタン(オブジェクト名：output_n)
の２パターンで取得するものをつくりたいと考えています。

拡張子ありのほうは、以下のように作成しました。
-----------------------------------------------------------
Private Sub output_Click()

Dim Target As String
Dim Extraction As Variant
Dim buf As String
Dim i As Long


'入力欄の値を取得

Target = Target_i.Value

'ファイル名取得
If Target = "" Then
MsgBox "パスを入力してください"
Exit Sub
End If

buf = Dir(Target & "*.*")

Do While buf <> ""
i = i + 1
Cells(i, 1) = buf
buf = Dir()
Loop

MsgBox i & "件ありました。"

End Sub
-----------------------------------------------------------
拡張子ありのこのコードは問題なく動作しています。
これを応用して拡張子なしに対応したものを作成したいのですが、
以下のようなコードにしたところ、エラーとなりました。
-----------------------------------------------------------
Private Sub output_n_Click()

Dim Target As String
Dim buf As String
Dim i As Long
Dim FileName As Object

Dim sFilename As String
Dim Findpoint As Long
Dim strLen As Long

'入力欄の値を取得
Target = Target_i.Value


'空白かチェック
If Target = "" Then
MsgBox "パスを入力してください"
Exit Sub
End If

'ファイル名取得
buf = Dir(Target & "*.*")

'拡張子をとる
sFilename = buf.getbasename(sFilename)　　　←ここのbufが黄色で反転

Do While strPath <> ""
i = i + 1
Cells(i, 1) = strPath
strPath = Dir()
Loop

MsgBox i & "件ありました。"

End Sub
-----------------------------------------------------------
エラー内容は、
【コンパイルエラー：装飾子が不正です。】です。

一度ファイル名を取得し、拡張子をとった値を返したいのですが、
取得したファイル名（buf）から拡張子をとるにはどうすればよいでしょうか。

にわかの私にはこれ以上がわかりません。
どなたか教えてください。

宜しくお願いします。

No.2 ベストアンサー 回答者： WindFaller 回答日時： 2015/03/05 12:43

こんにちは。

ふつう、このような場合は、FileSystemObject (objFS) ではなく、InstrRev で、後ろから、コンマを探して、切り捨てます。

例：
Fn = "Test1.xlsx"
i = InStrRev(Fn, ".")
Debug.Print Left(Fn, i - 1)

なぜ、FileSystemObjectを使わないかというと、オブジェクトを呼びこむ時の時間、つまりオーバーヘッドが掛かるからです。今回は、ご質問者様の内容をそのまま活かしました。

'//
Private Sub output_n_Click()
　Dim Target　　 As String
　Dim Target_i　　 As Range
　Dim objFS　　　As Object 'FileSystemObject
　Dim buf　　　　As String
　Dim i　　　　　As Long
　Dim FileName　 As Object
　Dim strPath　　As String
　Dim Findpoint　As Long
　Dim strLen　　 As Long
　
　Set objFS = CreateObject("Scripting.FilesystemObject")
　
'入力欄の値を取得
　Set Target_i = ActiveCell　'←※臨時で置きました。
　Target = Target_i.Value

'空白かチェック
If Target = "" Then
　　MsgBox "パスを入力してください"
　　Exit Sub
End If

'ファイル名取得
buf = Dir(Target & "*.*")
'拡張子をとる
　Do
　i = i + 1
　strPath = objFS.GetBaseName(buf)　'ループの中に入れました。
　Cells(i, 1).Value = strPath
　buf = Dir()
　Loop While buf <> "" '判定はbuf でします。
　
　MsgBox i & "件ありました。"
End Sub
'//

この回答へのお礼

ご回答ありがとうございます。
アドバイスに基づき、下記のように変更したところ、ファイル名を取得できました。

（一部抜粋）
Do While buf <> ""
i = i + 1
k = InStrRev(buf, ".") 'カンマの位置を特定
out = Left(buf, k - 1) 'カンマから左を返す
Cells(i, 1) = out
buf = Dir()
Loop

オーバーヘッドのことなど、考慮できていない点がありました。
具体的なサンプルを提示していただき、大変助かりました。

やはり継ぎ接ぎのコードでは不具合が出たとき対応できないことがわかりました・・・
今後は理解に重点をおき、もう少し勉強します。
２名の方、ありがとうございました。

お礼日時：2015/03/05 17:31

No.3 回答者： nicotinism 回答日時： 2015/03/05 16:54

失礼しました。

以下の場合などではコンパイルエラーにはなりませんね。
１・VBE でツール→オプション→変数の宣言を強制する のチェックが外れている場合。
　　ただし、実行すると、実行時エラー424 で止まるハズ？
２・Target_i をどこか別の所でオブジェクト型でパブリック変数とし、セットしている場合
まだ有るかもしれませんが取りあえず思いついたのはこのケースです。

この回答へのお礼

私の拙い説明で、深いところまで察して頂き誠にありがとうございます。
Target_iは別のところで変数としてセットしていました。

また困ったことがありましたら質問をすることもあると思いますが、
その時はどうぞよろしくお願いします。

ありがとうございました。

お礼日時：2015/03/05 17:33

No.1 回答者： nicotinism 回答日時： 2015/03/05 12:16

あなたが問題なく動くという

Private Sub output_Click() でも
>Target = Target_i.Value
↑ここでコンパイルエラーになるハズなんですけどね？

GetBaseName はFileSystemobject から利用することになります。
http://officetanaka.net/excel/vba/filesystemobje …
貴方のようにテキトーに繋げてもエラーになるだけです。

この回答へのお礼

>貴方のようにテキトーに繋げてもエラーになるだけです。
返す言葉もございません・・・
きちんと理解できるよう、勉強します。
コンパイルエラーになるはずのところで、問題なく動いていた理由は
不明ですが・・・
ありがとうございました。

お礼日時：2015/03/05 14:57