本文主要是介绍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より、指定したファイルを取得するマクロ（パス入り）
'作成者： SHSC
'作成日： 2006/01/13
'修正履歴：YYYY/MM/DD Name Content
'
'
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("RTM")
'設定値取得
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)
'Call CheckOutVSSItem(objItem)
Call CheckInVSSItem(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 Sub CheckOutVSSItem(objItem As VSSItem)
Dim dir As String
dir = CreateDir(objItem)
objItem.CheckOut "", dir & objItem.Name, VSSFLAG_REPREPLACE
End Sub
Private Sub CheckInVSSItem(objItem As VSSItem)
Dim dir As String
dir = CreateDir(objItem)
objItem.CheckIn "", dir & objItem.Name, VSSFLAG_UPDUPDATE
End Sub
'出力先フォルダ作成
Private Function CreateDir(objItem As VSSItem) As String
Dim i As Integer
Dim dirs() As String
Dim dir As String
Dim file As String
file = objItem.Spec
file = Replace(file, "$/50Source", "")
dirs = Split(file, "/")
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
这篇关于VSSより、指定したファイルを取得するマクロ的文章就介绍到这儿，希望我们推荐的文章对编程师们有所帮助！
