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