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
本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利。
博文来源广泛，如原作者认为我侵犯知识产权，请尽快给我发邮件 359031282@qq.com联系，我将以第一时间删除相关内容。
