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
