ＶｉｓｕａｌＢａｓｉｃでファイル名から拡張子.まで取り除くには？

VBでファイル名から拡張子を取り除く関数を探しています。なにか良い関数はないでしょうか？

No.4 ベストアンサー 回答者： noname#7749 回答日時： 2004/03/05 07:38

InStrRevが使えなかった当時 ( Office97 の時代 )、ファイル処理用にいろいろな文字列関数を作っていました。

下記は、その一例です。
(今見直してみると、FSOで実現できそうな機能が多いのですが......)


Option Explicit

Public Const DRIVE_UNKNOWN As Long = 0&
Public Const DRIVE_NO_ROOT_DIR As Long = 1&
Public Const DRIVE_REMOVABLE As Long = 2&
Public Const DRIVE_FIXED As Long = 3&
Public Const DRIVE_REMOTE As Long = 4&
Public Const DRIVE_CDROM As Long = 5&
Public Const DRIVE_RAMDISK As Long = 6&

Public Enum CommonDialogMode 'コモンダイアログの操作を条件分岐。
FileMode
FolderMode
End Enum

Public Declare Function GetDriveType Lib "kernel32" _
Alias "GetDriveTypeA" (ByVal strDriveLetter As String) As Long

'ファイル名のみの比較。"*.拡張子"の".拡張子"だけを取り除く。
Public Function CutFileExtFromPath(ByVal strFileName As String) As String
Dim i As Integer

strFileName = Trim$(strFileName)

If Len(strFileName) = 0 Then
CutFileExtFromPath = ""
Exit Function
End If

'"."が複数含まれる場合もありうるので、右側から、最初の"."を検出。
For i = 1 To Len(strFileName)
If Mid$(Right$(strFileName, i), 1, 1) = "." Then
'2003/05/18 パスの一部(フォルダ名)に「.」が含まれ、かつファイルに拡張子がない場合の対応。
If InStr(Right$(strFileName, i), "\") = 0 Then
strFileName = Mid$(strFileName, 1, Len(strFileName) - i)
Exit For
End If
End If
Next
CutFileExtFromPath = strFileName
End Function

'ファイルの拡張子を取得する。
Public Function GetFileExtName(ByVal strFileName As String) As String
Dim i As Integer

If Len(strFileName) = 0 Then
GetFileExtName = ""
Exit Function
End If
strFileName = Trim$(strFileName)
'"."が複数含まれる場合もありうるので、右側から、最初の"."を検出。
'2000/12/21 拡張子がない場合、長さゼロの文字列を返すよう修正。
If Not CutFileExtFromPath(strFileName) = strFileName Then
For i = 1 To Len(strFileName)
If Mid$(Right$(strFileName, i), 1, 1) = "." Then
strFileName = Right$(strFileName, i - 1)
Exit For
End If
Next
GetFileExtName = strFileName
Else
GetFileExtName = ""
End If
End Function

'フルパス + ファイル名から、パス名のみ取り出す。
Public Function GetFilePathOnly(ByVal vntPathFileName As Variant) As String
Dim i As Integer

vntPathFileName = Trim$("" & vntPathFileName)

If Len(vntPathFileName) = 0 Then
GetFilePathOnly = ""
Exit Function
End If

'右側から、最初の"\"を検出し、取り除く。
For i = 1 To Len(vntPathFileName)
If Mid$(Right$(vntPathFileName, i), 1, 1) = "\" Then
vntPathFileName = Mid$(vntPathFileName, 1, Len(vntPathFileName) - i)
Exit For
End If
Next
GetFilePathOnly = vntPathFileName
End Function

'2001/10/07 関数追加。
'フルパス + ファイル名から、ファイル名のみ取り出す。
'(パスが有効な場合はDir関数でも同等の操作は可能だが、パスが無効な場合は×。
'当関数は、文字列操作のみなので、パス、ファイルの存在有無に関係ありません)
Public Function GetFileNameOnlyFromPath(ByVal vntPathFileName As Variant) As String
Dim i As Integer

vntPathFileName = Trim$("" & vntPathFileName)

If Len(vntPathFileName) = 0 Then
GetFileNameOnlyFromPath = ""
Exit Function
End If

'右側から、最初の"\"を検出し、取り除く。
For i = 1 To Len(vntPathFileName)
If Mid$(Right$(vntPathFileName, i), 1, 1) = "\" Then
vntPathFileName = Mid$(vntPathFileName, Len(vntPathFileName) - i + 2)
Exit For
End If
Next
GetFileNameOnlyFromPath = vntPathFileName
End Function

Public Function GetLongFileName(ByVal strShortName As String) As String
'ShortName → LongName に変換する。
Dim strLongName As String
Dim strTmp As String
Dim intYenSignPos As Integer

'Add \ to short name to prevent Instr from failing
If Right$(strShortName, 1) <> "\" Then
strShortName = strShortName & "\"
End If

'Start from 4 to ignore the "[Drive Letter]:\" characters
intYenSignPos = InStr(4, strShortName, "\")

'Pull out each string between \ character for conversion
On Error Resume Next
While intYenSignPos
strTmp = Dir(Left$(strShortName, intYenSignPos - 1), _
vbNormal + vbHidden + vbSystem + vbDirectory)
If Err.Number <> 0 Then
strTmp = GetFileNameOnlyFromPath(Left$(strShortName, intYenSignPos - 1))
Err.Clear
End If
If Len(strTmp) = 0 Then
GetLongFileName = ""
Exit Function
End If
strLongName = strLongName & "\" & strTmp
intYenSignPos = InStr(intYenSignPos + 1, strShortName, "\")
Wend
On Error GoTo 0

'Prefix with the drive letter
If Left$(strShortName, 2) <> "\\" Then
GetLongFileName = Left$(strShortName, 2) & strLongName
Else
GetLongFileName = "\" & strLongName
End If

End Function

Public Function GetRootDriveName(ByVal strFullPath As String) As String
'指定パスのルートドライブ名を取得。
'(URLパスにも対応)
Dim lngRet As Long
Dim i As Long

If Len(strFullPath) = 0 Then
strFullPath = CodeDb().Name
End If

lngRet = InStr(strFullPath, "\")

If lngRet > 0 Then
If lngRet = 1 Then
For i = 1 To Len(strFullPath)
If Mid$(strFullPath, i, 1) <> "\" Then
strFullPath = Mid$(strFullPath, i)
Exit For
End If
Next i

lngRet = InStr(strFullPath, "\")

If lngRet = 0 Then
GetRootDriveName = strFullPath
Exit Function
End If
End If
Else
lngRet = InStr(strFullPath, "/")
Select Case lngRet
Case 0
GetRootDriveName = strFullPath
Exit Function
Case 1
For i = 1 To Len(strFullPath)
If Mid$(strFullPath, i, 1) <> "/" Then
strFullPath = Mid$(strFullPath, i)
Exit For
End If
Next i
Case Else
If Mid$(strFullPath, lngRet - 1, 3) = "://" Then
strFullPath = Mid$(strFullPath, lngRet + 2)
End If
End Select

lngRet = InStr(strFullPath, "/")

If lngRet = 0 Then
GetRootDriveName = strFullPath
Exit Function
End If
End If

GetRootDriveName = Left$(strFullPath, lngRet - 1)
End Function

Public Function GetCorrectFileName(ByRef strSourceFileName As String, Optional ByVal Mode As CommonDialogMode = FileMode) As String

'********************************************************************************************************
'
'機能概要 : 指定の文字列から、ファイル名、フォルダ名として使用できない文字を取り除く。
'
'引　　数 : strSourceFileName 処理対象文字列。
'　　　 Mode 処理モード (省略可能。規定値はファイルモード)
'
'戻 り 値 : 変換後文字列。
'
'備　　考 : 文字列をフルパスとして扱う場合は、"\"、":"は削除しない。
'
'********************************************************************************************************

Dim strRet As String

strRet = strSourceFileName

If Mode = FileMode Then
strRet = Replace(strRet, "\", "")
strRet = Replace(strRet, ":", "")
End If

strRet = Replace(strRet, "/", "")
strRet = Replace(strRet, ",", "")
strRet = Replace(strRet, ";", "")
strRet = Replace(strRet, "*", "")
strRet = Replace(strRet, "?", "")
strRet = Replace(strRet, """", "")
strRet = Replace(strRet, "<", "")
strRet = Replace(strRet, ">", "")
GetCorrectFileName = Replace(strRet, "|", "")
End Function

No.6 回答者： imogasi 回答日時： 2004/03/07 07:40

#1です。

「.」が２つ以上ある場合を考慮すると
Sub test01()
a = "aaa.bbb.ccc.dddd.txt"
s = 1
p01:
p = InStr(s, a, ".")
If p = 0 Then GoTo p02
s = p + 1
GoTo p01
p02:
MsgBox Mid(a, 1, s - 2)
End Sub
拡張子部分を除いた文字列でＮａｍｅ　Ａｓする。
こんな質問ではないのかな。

No.5 回答者： maruru01 回答日時： 2004/03/05 09:19

こんにちは。

maruru01です。

APIもあります。
拡張子を除く関数は、No.3の方の参考URLのと同じですが、他にもいろいろなパス操作関連のAPIサンプルが載っているサイトを紹介します。

http://www31.ocn.ne.jp/~heropa/vba.htm

ここの、[Visual Basic Tips]→[Shell Lightweight Utility APIs]→[パス操作]にいろいろあります。
ご参考までに。

参考URL：http://www31.ocn.ne.jp/~heropa/vba.htm

No.3 回答者： nishi6 回答日時： 2004/03/05 07:37

関数を書いてみました。

Function myRemoveExtension(ByVal strFilename As String)
　　'// パスがあったら除く(最後の『\』を探す)
　　If InStr(strFilename, "\") <> 0 Then
　　　　strFilename = Right(strFilename, Len(strFilename) - InStrRev(strFilename, "\"))
　　End If

　　'// 拡張子を除く(『.』を探す)
　　If InStr(strFilename, ".") = 0 Then
　　　　'// 『.』がない場合はなにもしない
　　　　myRemoveExtension = strFilename
　　Else
　　　　'// 『.』がある場合は最後の『.』を拡張子部分とする
　　　　myRemoveExtension = Left(strFilename, InStrRev(strFilename, ".") - 1)
　　End If
End Function

　

参考URL：http://www.vbvbvb.com/jp/gtips/0201/gPathRemoveE …

No.2 回答者： taka_tetsu 回答日時： 2004/03/05 02:08

>p = InStr(a, ".")

これじゃだめ。
ファイル名中にピリオドが2つ以上あるときを考慮していない。

InStrRevを使いましょう。

a = "abc.def.txt"
MsgBox Left(a, InStrRev(a, ".") - 1)

No.1 回答者： imogasi 回答日時： 2004/03/04 21:26

Sub test01()

a = "abcdef.txt"
p = InStr(a, ".")
a = Mid(a, 1, p - 1)
MsgBox a
End Sub