VSSより、指定したファイルを取得するマクロ（パス入り）

Option Explicit
'VSSのiniファイルの場所
Private SRCSAFE_INI As String
'VSS接続のユーザID
Private USER_ID As String
'VSS接続のパスワード
Private USER_PASSWORD As String
'VSS Root
Private VSS_ROOT As String
'ファイル出力・
Private OUTPUT_DIR As String
'ファイルオブジェクト
Private mobjFileSystem As FileSystemObject
'機能名：　VSSより、指定したファイルを取得するマクロ（パス入り）
'
Sub Macro1()
    On Error GoTo ErrorHandler
    Dim vssDB As New VSSDatabase
    Dim objItem As VSSItem
    Dim rowNumber As Integer
    Dim sheet As Worksheet
   
    Set mobjFileSystem = New FileSystemObject
    Set sheet = ThisWorkbook.Worksheets("VSSFM")'sheet name is VSSFM->VSS's file management
 
    '設定値取・
    Call GetSettingValues
   
    '行番号初期・
    rowNumber = 2
   
    'VSS接・
    vssDB.Open SRCSAFE_INI, USER_ID, USER_PASSWORD
   
    While sheet.Cells(rowNumber, 1) <> ""
        'CO対象かをチェック
        If sheet.Cells(rowNumber, 2) = "○" Then
            Set objItem = vssDB.VSSItem(VSS_ROOT & sheet.Cells(rowNumber, 8))
            Call OutputVSSItem(objItem)
        End If
        rowNumber = rowNumber + 1
    Wend
   
    Set vssDB = Nothing
    Set mobjFileSystem = Nothing
   
    MsgBox "ファイル取得が完了しました。"
   
Exit Sub                                ' エラー処理ルーチンが実行されないように Sub を終了します。
ErrorHandler:                           ' エラー処理ルーチン。
    Select Case Err.Number              ' エラー番号を評価します。
        Case -2147166577                ' エラーです。
            MsgBox "[" & VSS_ROOT & sheet.Cells(rowNumber, 8) & "] が見つかりません。"
            Resume Next                 ' エラーが発生した行から処理を再開します。
           
        Case Else
            Resume Next                 ' エラーが発生した行から処理を再開します。
    End Select
   
End Sub
'設定値を変数へ格納
Private Sub GetSettingValues()
    Dim sheet As Worksheet
   
    Set sheet = ThisWorkbook.Worksheets("設定")
   
    'srcsafe.iniの場所
    SRCSAFE_INI = sheet.Cells(3, 2)
    'VSS接続ユーザID
    USER_ID = sheet.Cells(4, 2)
    'VSS接続ユーザパスワード
    USER_PASSWORD = sheet.Cells(5, 2)
    'VSS Root
    VSS_ROOT = sheet.Cells(6, 2)
   
    'ファイル出・
    OUTPUT_DIR = sheet.Cells(7, 2)
   
End Sub
'指定フォルダへ最新バージョンのファイルを出力する処理
Private Sub OutputVSSItem(objItem As VSSItem)
    '出力先フォルダ設・
    Dim dir As String
   
    dir = CreateDir(objItem)
    objItem.Get dir & objItem.Name, VSSFLAG_EOLCRLF
End Sub
'出力先フォルダ作・
Private Function CreateDir(objItem As VSSItem) As String
    Dim i As Integer
    Dim dirs() As String
    Dim dir As String
   
    dirs = Split(objItem.Spec, "/")
    dir = OUTPUT_DIR
   
    For i = LBound(dirs) To UBound(dirs) - 1
        dir = dir & dirs(i)
        If Not mobjFileSystem.FolderExists(dir) Then
            Call FileSystem.MkDir(dir)
        End If
       
        dir = dir & "/"
    Next i
    CreateDir = dir
End Function