VBAでよく使うプロシージャ(FileSystemObject)


FileSystemObjectの呼び出し

VBAでファイルやそれに伴う処理を扱う場合にFileSystemObjectを使用するが、そのたびに以下の記述が必要になる。

' 参照設定しない場合
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")

' 参照設定する場合
Dim FSO As FileSystemObject
Set FSO = New FileSystemObject()

面倒なのでよく使う機能はFileSystemと名前をつけてモジュール化しています。

モジュール化

Const ForReading As Long = 1
Const ForWriting As Long= 2 
Const ForAppending As Long = 8

Const TristateUseDefault As Long = -2
Const TristateTrue As Long = -1
Const TristateFalse As Long = 0

Public Function FileExists(ByVal path As String) As Boolean
    'ファイルの存在確認
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FileExists = FSO.FileExists(path)
End Function

Public Function FolderExists(ByVal path As String) As Boolean
    'フォルダの存在確認
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FolderExists  = FSO.FolderExists(path)
End Function

Public Function DriveExists(ByVal drive As String) As Boolean
    'ドライブの存在確認
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    DriveExists  = FSO.DriveExists(drive)
End Function

Public Sub CreateFolder(ByVal path As String)
    '再帰的にフォルダを作成する
    Dim FSO As Object
    Dim Parent As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FolderExists(path) Then
        Exit Sub
    End If
    Parent = GetParentFolderName(path)
    If Not FSO.FolderExists(Parent) Then
        Call CreateFolder(Parent)
    End If
    Call FSO.CreateFolder(path)
End Sub

Public Function GetAbsolutePathName(ByVal path As String) As String
    '相対パスから絶対パスを取得
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    GetAbsolutePathName  = FSO.GetAbsolutePathName(path)
End Function

Public Function GetFileName(ByVal path As String) As String
    'ファイル名を取得
    'C:\foo\bar\hoge.txt -> hoge.txt
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    GetFileName = FSO.GetFileName(path)
End Function

Public Function GetBaseName(ByVal path As String) As String
    '拡張子を除いたファイル名を取得
    'C:\foo\bar\hoge.txt -> hoge
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    GetBaseName = FSO.GetBaseName(path)
End Function

Public Function GetExtensionName(ByVal path As String) As String
    '拡張子を取得
    'C:\foo\bar\hoge.txt -> txt
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    GetExtensionName = FSO.GetExtensionName(path)
End Function

Public Function GetDriveName(ByVal path As String) As String
    'ドライブレターを取得
    'C:\foo\bar\hoge.txt -> C
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    GetDriveName= FSO.GetDriveName(path)
End Function

Public Function GetParentFolderName(ByVal path As String) As String
    'ペアレントパスを取得
    'C:\foo\bar\hoge\-> C:\foo\bar
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    GetParentFolderName= FSO.GetParentFolderName(path)
End Function

Public Function GetTempName(Optional ByVal ext As String = "") As String
    'ランダムなファイル名を取得
    'デフォルトでは拡張子はtmp
    'extを設定すれば任意の拡張子に変更する
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    GetTempName= FSO.GetTempName()
    If ext <> "" Then
        GetTempName = FSO.GetBaseName(GetTempName) & "." & ext
    End If
End Function

Public Sub CopyFile(ByVal src As String, ByVal dest As String)
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Call FSO.CopyFile(src, dest)
End Sub

Public Sub CopyFolder(ByVal src As String, ByVal dest As String)
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Call FSO.CopyFolder(src, dest)
End Sub

Public Sub MoveFile(ByVal src As String, ByVal dest As String)
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Call FSO.MoveFile(src, dest)
End Sub

Public Sub MoveFolder(ByVal src As String, ByVal dest As String)
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Call FSO.MoveFolder(src, dest)
End Sub

Public Sub DeleteFile(ByVal path As String)
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Call FSO.DeleteFile(path)

End Sub

Public Sub DeleteFolder(ByVal path As String)
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Call FSO.DeleteFolder(path)
End Sub

Public Function JoinPath(ByVal base As String, ParamArray paths() As Variant) As String
    'pathsの数だけパスを連結する
    'JoinPath("C\foo","bar\","\hoge.txt") -> C:\foo\bar\hoge.txt
    Dim FSO As Object
    Dim path As Variant
    Set FSO = CreateObject("Scripting.FileSystemObject")
    JoinPath = base
    For Each path In paths
        JoinPath = FSO.BuildPath(JoinPath, path)
    Next
End Function

Public Function CreateTextFile(ByVal path As String, _
        Optional ByVal overwrite As Boolean = True, _
        Optional ByVal unicode As Boolean = False ) As Object
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set CreateTextFile = FSO.CreateTextFile(path, overWrite, unicode)
End Function

Public Function OpenAsTextStream(ByVal path As String, _
        Optional ByVal IOMode As Long = ForReading, _
        Optional ByVal fomatMode As Long = TristateFalse ) As Object
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set OpenAsTextStream = FSO.OpenAsTextStream(path, IOMode, fomatMode)
End Function

Public Function OpenTextFile(ByVal path As String, _
        Optional ByVal IOMode As Long = ForReading, _
        Optional ByVal Create As Boolean = False, _
        Optional ByVal fomratMode As Long = TristateFalse ) As Object
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set OpenTextFile = FSO.OpenTextFile(path, IOMode, Create, fomratMode)
End Function

これをVBEでインポートして使っています。 呼び出すたびにオブジェクトをインスタンス化しているのでループ内で使用すると処理に時間がかかってしもうかもしれません。

WSH(jscript)で再帰的にショートカット作成

第1引数でショートカットを置くフォルダーを指定して、第2引数以降でショートカットを作りたいファイルのあるフォルダーを指定する

var linkDir = WScript.Arguments(0)
var fso = new ActiveXObject("scripting.FileSystemObject")
var shell = new ActiveXObject("WScript.Shell")

function makeShortcut(dirPath){
    var folder = fso.getFolder(dirPath)
    var subFolders = new Enumerator(folder.subFolders)
    for(;!subFolders.atEnd(); subFolders.moveNext()){
        makeShortcut(subFolders.item())
    }

    var files = new Enumerator(folder.files)
    for(; !files.atEnd(); files.moveNext()){
        var srcFile = files.item()
        var baseName = fso.getBaseName(srcFile)
        var linkFile = fso.buildPath(linkDir, baseName + ".lnk")
        var shortcut = shell.CreateShortcut(linkFile)
        shortcut.TargetPath = srcFile
        shortcut.Save()
    }
}

for(var i = 1; i < WScript.Arguments.length; i++){
    makeShortcut(WScript.Arguments(i))
}

Python + selenium でクリック

import time
from selenium import webdriver
from selenium.common import exceptions

def click_element(element):
    max_try = 10
    interval = 0.5
    for i in range(max_try):
        try:
            element.click()
            return
        except (exceptions.NoSuchElementException, 
                    exceptions.StaleElementReferenceException):
            time.sleep(interval)
    raise exceptions.TimeoutException

d = webdriver.Chrome()
d.get('https://sample.com')
element= d.find_element_by_id('foo')
click_element(element)