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

    End Select

End Sub

'設定値を変数へ格納

Private Sub GetSettingValues()

    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)

'指定フォルダへ最新バージョンのファイルを出力する処理

Private Sub OutputVSSItem(objItem As VSSItem)

    '出力先フォルダ設・

    Dim dir As String

    dir = CreateDir(objItem)

    objItem.Get dir & objItem.Name, VSSFLAG_EOLCRLF

'出力先フォルダ作・

Private Function CreateDir(objItem As VSSItem) As String

    Dim i As Integer

    Dim dirs() 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)

        dir = dir & "/"

    Next i

    CreateDir = dir

End Function

作者：

Candyメ奶糖

出处：

http://www.cnblogs.com/Candies/

本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利。

博文来源广泛，如原作者认为我侵犯知识产权，请尽快给我发邮件

[email protected]

联系，我将以第一时间删除相关内容。