VBA フォルダ、ファイル移動に関する関数

毎度毎度、思い出すのも面倒なので。ファイル操作でよく使うマクロ一式です。

【フォルダ削除】

myFol=引数はフルパスにします

Function FolderDelete(ByVal myFol As String)
    Set objFile=CreateObject("Scripting.FileSystemObject")
         If objFile.FolderExists(myFol) Then
             objFile.GetFolder(myFol).Delete
         End If
    Set objFile=Nothing
End Function

【ファイルコピー】

srcFile,dstFileもフルパス指定

Function FileCopy(ByVal srcFile As String, ByVal dstFile As String)
    Set objFS=CreateObject("Scripting.FileSystemObject")
        objFS.CopyFile srcFile, dstFile
    Set objFS=Nothing
End Function

【ファイル移動】

Function FileMove(ByVal srcFile As String, ByVal dstFile As String)
    Set objFS=CreateObject("Scripting.FileSystemObject")
        objFS.MoveFile srcFile, dstFile
    Set objFS=Nothing
End Function

【フォルダ作成】

深いネストまで一気に作成(親フォルダが存在しなければ作る）

Sub myMkDir(ByVal sPath as String)
    Dim iStart  As Integer
    Dim aDirs   As Variant
    Dim sCurDir As String
    Dim i       As Integer

        If sPath <> "" Then
            aDirs=Split(sPath, "\")
            If Left(sPath,2)="\\" Then
                iStart=3
            Else
                iStart=1
            End If

            sCurDir=Left(sPath,InStr(iStart,sPath,"\")
                For i=iStart to UBound(aDirs)
                    sCurDir = sCurDir & aDirs(i) & "\"
                    If Dir(sCurDir, vbDirectory)=vbNullString Then
                        MkDir sCurDir
                    End If 
                Next
         End If
End Sub

【フォルダ内のサブフォルダ数を取得する】

もちろん、サブフォルダ名も取得できます

Function FolCnt(ByVal myFol As String) As Integer
    Dim objFSO As Object
    Dim objRoot As Object

    Set objFSO=CreateObject("Scripting.FileSystemObject")
    Set objFolder=objFSO
    Set objRoot=objFSO.GetFolder(myFol)

    myCnt=0

    For Each Fol In objRoot.SubFolders
        Debug.Print Fol
        If Fol.Name Like "*ほげほげ*" Then
            myCnt = myCnt + 1
        End If
   Next Fol

   FolCnt = myCnt

End Function

【ファイルのタイムスタンプを取得する】

Sub GetFileTimeStamp()

Dim objFileSys As Object
Dim strScriptPath As String
Dim strFilePath   As String
Dim objFile       As Object

Set objFileSys = CreateObject("Scripting.FileSystemObject")
    strScriptPath="C:\aaa\bbb\"

    strFilePath=objFileSys.BuildPath(strScriptPath, "aaa.xlsx")
    Set objFile = objFileSys.GetFile(strFilePath)

    Debug.Print "作成日:" & objFile.DateCreated
    Debug.Print "最終アクセス:" & objFile.DateLastAccessed
    Debug.Print "最終更新日:" & objFile.DateLastModified

Set objFile = Nothing
Set objFileSys = Nothing

End Sub