よく見かけるVBサンプル集 MENU　000～009

'
'[ファイル名から拡張子を取り出す]
'
'■ 引数
'strFileName:フルパスのファイル名
'□ 戻り値:拡張子名
Public Function Extension(ByVal strFileName As String) As String
   Dim intPos As Integer
   Extension = "" '初期化

   intPos = Len(strFileName)

   Do While intPos > 0
      Select Case Mid(strFileName, intPos, 1)
      　　Case "."
      　　　　　Extension = StrConv(Mid(strFileName, intPos + 1), vbUpperCase)
      　　　　　Exit Do
      　　Case "\", "/"
      　　　　　Exit Do
      End Select
   intPos = intPos - 1
   Loop
End Function

TOP

フルパスからファイル名のみを取得

使用API

フルパスからファイル名のみを取得

使用APIなし

ファイル名=GetFullPasToFileName(フルパスのファイル名)

使用例

X = GetFullPasToFileName("C:\10246\abc\sss\100.Dat")

'
'[フルパスからファイル名のみを取得]
'
'■ 引数
'FullPas:フルパスのファイル名
'□ 戻り値:ファイル名
Public Function GetFullPasToFileName(ByVal FullPas As String) As String
　Dim i As Integer, tmp As String

　For i = Len(FullPas) To 1 Step -1
       Select Case Mid$(FullPas, i, 1)
       　　Case "\", ":"
            　　　GetFullPasToFileName = Mid$(FullPas, i + 1)
            　　　Exit For
       End Select
Next i
End Function

TOP

フルパスからパス名のみを取得

使用API

フルパスからパス名のみを取得

使用APIなし

パス名=GetPathNameToFullPas(フルパスのファイル名)

使用例

X = GetPathNameToFullPas("C:\10246\abc\sss\100.Dat")

'
'[フルパスからパス名のみを取得]
'
'■ 引数
'strFileName:フルパスのファイル名
'□ 戻り値:ファイル名
Public Function GetPathNameToFullPas(ByVal strFileName As String) As String
Dim intPos As Integer
Dim strPathOnly As String
Dim intLoopCount As Integer
On Error Resume Next
Err = 0
intPos = Len(strFileName)
'すべての '/' 記号を '\'記号に変更します。
     For intLoopCount = 1 To Len(strFileName)
           If Mid(strFileName, intLoopCount, 1) = "/" Then
           Mid(strFileName, intLoopCount, 1) = "\"
           End If
     Next intLoopCount

     If InStr(strFileName, "\") = intPos Then
         If intPos > 1 Then intPos = intPos - 1
     Else
         Do While intPos > 0
               If Mid(strFileName, intPos, 1) <> "\" Then
               　　intPos = intPos - 1
               Else
               　　Exit Do
               End If
          Loop
     End If

     If intPos > 0 Then
      strPathOnly = Left(strFileName, intPos)
      If Right(strPathOnly, 1) = ":" Then strPathOnly = strPathOnly & "\"
     Else
     strPathOnly = CurDir
     End If

     If Right(strPathOnly, 1) = "\" Then
       strPathOnly = Left(strPathOnly, Len(strPathOnly) - 1)
     End If

     GetPathNameToFullPas = strPathOnly
     Err = 0
End Function

TOP

実在のパスが存在するか調べる

使用API

実在のパスが存在するか調べる

使用APIなし

パスの有無=FilePasExists(パス)

使用例

X = FilePasExists("c:\abc\gfgh\")

'
'[実在のパスが存在するか調べる]
'
'■ 引数
'strPathName:フルパスのファイル名
'□ 戻り値:パスの有無(True=存在する ,False=存在しない)
Public Function FilePasExists(ByVal strPathName As String) As Boolean
Dim strResult As String
On Error Resume Next
If strPathName = "" Then Exit Function
'フォルダーに \ をつけるかどうか識別
If Right(strPathName, 1) <> "\" Then strPathName = strPathName & "\"

strResult = Dir(strPathName & "*.*", vbDirectory)
FilePasExists = IIf(strResult = "", False, True)

Err = 0
End Function

TOP

ファイルの有無を調査する

使用API

ファイルの有無を調査する

使用APIなし

パス名=FileExists(フルパス)

使用例

X = FileExists(c:\abc\001.dat)

'
'[ファイルの有無を調査する]
'
'■ 引数
'FileName:フルパスのファイル名
'□ 戻り値:パスの有無(True=存在する ,False=存在しない)
Public Function FileExists(ByVal FileName As String) As Boolean
Dim TempAttr As Integer

If (Len(FileName) = 0) Or (InStr(FileName, "*") > 0) Or _
                                                 (InStr(FileName, "?") > 0)   Then
     FileExists = False
     Exit Function
End If
On Error GoTo ErrorFileExist
' ファイルの属性を得る
TempAttr = GetAttr(FileName)
' ディレクトリであるかどうか調べる
FileExists = ((TempAttr And vbDirectory) = 0)
GoTo ExitFileExist
ErrorFileExist:
FileExists = False
Resume ExitFileExist
ExitFileExist:
On Error GoTo 0
End Function

TOP

ファイルをロックする

使用API

ファイルをロックする

使用APIなし

使用されたファイル番号 =FileLock(ファイル名)

使用例

X = FileLock("abc.dat")

'
'[ファイルをロックする]
'
'■ 引数
'strFileName:フルパスのファイル名
'□ 戻り値:使用されたファイル番号
Public Function FileLock(ByVal strFileName As String) As Integer
    Dim intFreeFileNum As Integer
    ' ファイルの有無を調べる
    On Error GoTo FileLockError

     If Dir(strFileName) = "" Then
        FileLock = 0
        Exit Function
     End If

    intFreeFileNum = FreeFile

     Open strFileName For Binary Access Write Lock Read Write As intFreeFileNum
     FileLock = intFreeFileNum
     Exit Function
FileLockError:
     FileLock = 0
End Function

関連サンプル

ロックされたファイルを解放

TOP

ロックされたファイルを解放

使用API

ロックされたファイルを解放

使用APIなし

FileUnlock(ファイル番号)

使用例

call FileUnlock(0)

'
'[ロックされたファイルを解放]
'
'■ 引数
'intFileNum:フルパスのファイル名
'□ 戻り値:使用されたファイル番号
Public Sub FileUnlock(ByVal intFileNum As Integer)

If intFileNum = 0 Then Exit Sub
Close intFileNum

End Sub

関連サンプル

ファイルをロックする

TOP

指定パスに \記号をつけるか調査する

使用API

指定パスの最後尾に’\’が付いていない場合に、’\’記号を追加します。

使用APIなし

チェック済みのパス=mFileNameSignchk(調べる相対または絶対パス)

使用例

X = mFileNameSignchk("c:") 'xはc:\が戻ってくる

'
'[指定パスの最後尾に’\’が付いていない場合に、’\’記号を追加します。]
'
'■ 引数
'FullFileName:調べる相対または絶対パス
'□ 戻り値:チェック済みのパス
Public Function mFileNameSignchk(ByVal FullFileName As String) As String
Dim S As String
If FullFileName = "" Then Exit Function
If Right(FullFileName, 1) <> "\" Then S = "\"
mFileNameSignchk = FullFileName & S
End Function

TOP

ファイルを検索する

使用API

[指定されたファイルを検索します]
Private Declare Function SearchPath Lib "kernel32" Alias "SearchPathA" _
(ByVal lpPath As String, _
ByVal lpFileName As String, _
ByVal lpExtension As String, _
ByVal nBufferLength As Long, _
ByVal lpBuffer As String, _
lpFilePart As Long) As Long

lpPath:
検索するフォルダパスを指定
lpFileName
検索するファイル
lpExtension
検索するファイルの拡張子
nBufferLength
バッファのサイズを、文字単位で指定します。(出力文字数分確保してください)
lpBuffer
検索されたパス名およびファイル名の結果がここへ返されます。
lpFilePart
この変数に、lpBuffer バッファ内のファイル名の部分のポインタが返されます。
最後の円記号（\）の直後になります。

関数が成功すると
バッファにコピーされた文字数が返ります(終端の NULL 文字を除く）。
ただし、バッファのサイズが足りなかった場合は、必要なバッファのサイズが返ります。
関数が失敗すると、0 が返ります。

結果=GetFileNameNow（ファイルを検索するパス,ファイル名,拡張子）

使用例

X = GetFileNameNow (vbNullString, "Notepad", ".exe")

'
'[指定されたファイルを検索します]
'
'■ 引数
'strSearchPathName:ファイルを検索するパス
'strSearchFileName:ファイル名
'strSearchExtention:拡張子
'□ 戻り値:結果(成功時=取得したパス名とファイル名)
Public Function GetFileNameNow(ByVal strSearchPathName As String, _
                         ByVal strSearchFileName As String, _
                         ByVal strSearchExtention As String) As String
   Dim strFoundPathFileName As String * 516
   Dim lngFileNamePart As Long
   Dim ret As Long
   ' ファイルを検索
   ret = SearchPath(strSearchPathName, _
                           strSearchFileName, _
                           strSearchExtention, _
                           Len(strFoundPathFileName), _
                           strFoundPathFileName, _
                           lngFileNamePart)
   ' 取得したパス名とファイル名
   GetFileNameNow = Left(strFoundPathFileName, _
                                    InStr(strFoundPathFileName, vbNullChar) - 1)
End Function

TOP

一時ファイルを作成する

使用API

[一時ファイル名を作成する]
Private Declare Function GetTempFileName Lib "kernel32" _
Alias "GetTempFileNameA" (ByVal lpPathName As String, _
ByVal lpPrefixString As String, _
ByVal uUnique As Long, _
ByVal lpTempFileName As String) As Long

lpPathName
テンポラリファイルを作成するパス名、または、
カレントディレクトリを示すピリオド’.’を指定します。
lpPrefixString
テンポラリファイルのファイル名の最初の文字として使われます。（3文字まで）
uUnique
符号なし整数を指定します。
0 を指定するとテンポラリファイルの一意性が保証され実際にファイルが作成されます。
0 以外の値を指定すると、指定した値の16 進表現を連結した名前になりますが、
ファイルは作成されません。
lpTempFileName
作成されたファイル名が格納されます。

関数が成功すると、0 以外の値が返ります。

ファイル名 = GetNewTmepName（パス名,プリフィックス,ファイル名に付加する数）

使用例

X = GetNewTmepName（".","New",1024）

'
'[一時ファイル名を作成する]
'
'■ 引数
'strPathName:パス名
'strPrefixString:プリフィックス
'lngUnique:ファイル名に付加する数
'□ 戻り値:結果(成功時=取得したパス名とファイル名)
Public Function GetNewTmepName(ByVal strPathName As String, _
                                              ByVal strPrefixString As String, _
                                              ByVal lngUnique As Long) As String
       Dim strTempFileName As String * 516
       Dim ret As Long
       ' 一時ファイル名を作成
       ret = GetTempFileName(strPathName, _
                                        strPrefixString, _
                                        lngUnique, _
                                        strTempFileName)
       ' 一時ファイル名
       GetNewTmepName = Left(strTempFileName, _
                                           InStr(strTempFileName, vbNullChar) - 1)
End Function

TOP