プロが教えるわが家の防犯対策術!

エクセルマクロについて
CSVファイルのファイル名を取得するにあたり、下記構文を見つけたのですが、拡張子の.csvも取得してしまいます。拡張子を除くにはどのように変更すれば良いのでしょうか?
Sub CSVまとめ()
Dim MyObj As Object
Dim MyFol As String
Dim MyFnm As String
Dim MyStr As String
Dim i As Long
Dim n As Long
Dim n1 As Long

'フォルダを選択する
Set MyObj = CreateObject("Shell.Application") _
.BrowseForFolder(0, "SelectFolder", 0)
'選択なければ処理を抜ける
If MyObj Is Nothing Then Exit Sub
MyFol = MyObj.self.Path & "\"
MsgBox MyFol & "を処理します。"
Set MyObj = Nothing
Application.ScreenUpdating = False
'ThisWorkbookにシートを追加して処理
With Sheets.Add
'Dir関数を使って指定フォルダ内csvファイルを順次処理
MyFnm = Dir(MyFol & "*.csv")
Do Until Len(MyFnm) = 0&
i = i + 1
'データエリアを取得してセット先を変更
n = IIf(n = 0, 1, n + n1)
'外部データ取り込みを利用
With .QueryTables.Add(Connection:="TEXT;" & MyFol & MyFnm, _
Destination:=.Range("B" & n))
.AdjustColumnWidth = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileCommaDelimiter = True
.Refresh False
n1 = .ResultRange.Rows.Count
.Parent.Names(.Name).Delete
.Delete
End With
'ファイル名をA列にセット
.Range("A" & n).Resize(n1).Value = MyFnm
'次のファイルへ
MyFnm = Dir()

Loop

End With
If i > 0 Then
MyStr = i & "個のファイルを処理しました。"
Else
'検索結果が0なら
MyStr = "検索条件を満たすファイルはありません。"
End If
Application.ScreenUpdating = True
MsgBox MyStr
End Sub

A 回答 (2件)

折角こちらでヒントを頂いているのですから


少しはご自分で考えてほしかったですね。
http://oshiete.goo.ne.jp/qa/9270401.html

'ファイル名をA列にセット
.Range("A" & n).Resize(n1).Value = Left(MyFnm, InStrRev(MyFnm, ".") - 1)
    • good
    • 0

MyFnm2=Left(MyFnm, Len(MyFnm)-4)


Left(str, n)は文字列strの左からn文字を取りだす関数。
Left(str)は文字列strの文字数を求める関数
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!