티스토리 툴바

달력

052012  이전 다음

  •  
  •  
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17
  • 18
  • 19
  • 20
  • 21
  • 22
  • 23
  • 24
  • 25
  • 26
  • 27
  • 28
  • 29
  • 30
  • 31
  •  
  •  

Option Explicit

Const CELL_PURPOSE = "$B$2"  ' リリース目的セル
Const CELL_WORKER = "$B$3"   ' 作業者セル
Const CELL_RDAY = "$B$4"     ' 作業日(リリース日)セル
Const CELL_PLACE = "$B$5"    ' リリース場所(DEV/STG/PRO)セル
Const BEGIN_RELEASE_LIST = 9 ' リリースリスト開始行

' --------------------------
'  リリース設定ファイル出力
' --------------------------
Sub OutputCfgFile()
    Dim purpose As String
    Dim name As String
    Dim worker As String
    Dim place As String
    Dim rday As String

    purpose = Trim(Range(CELL_PURPOSE))
    worker = Trim(Range(CELL_WORKER))
    place = Trim(Range(CELL_PLACE))
    rday = Trim(Range(CELL_RDAY))
    If Not IsDate(rday) Then
        MsgBox "日付が不正です。", vbInformation
        Range(CELL_RDAY).Activate
        Exit Sub
    End If
    rday = Format(rday, "yymmdd")
    ' -----------------------
    ' 保存ファイル名称
    ' -----------------------
    Dim defaultName As String
    defaultName = "release_" & StrConv(place, vbLowerCase) & "_" & rday & ".cfg"
    name = Application.GetSaveAsFilename(InitialFileName:=defaultName)
    If StrConv(name, vbUpperCase) = "FALSE" Then Exit Sub
    Dim myADOstr
    Set myADOstr = CreateObject("ADODB.Stream")
    myADOstr.Charset = "EUC-JP"
    myADOstr.Open

    ' -----------------------
    ' 基本リリース情報の出力 改行コード LFタイプ
    ' -----------------------
    myADOstr.WriteText "PURPOSE:" & purpose & vbLf
    myADOstr.WriteText "WORKER:" & worker & vbLf
    myADOstr.WriteText "RDAY:" & rday & vbLf
    myADOstr.WriteText "PLACE:" & place & vbLf
    ' --------------------
    ' ファイルリストの出力
    ' --------------------
    Dim i As Long
    Dim last As Integer
    i = BEGIN_RELEASE_LIST
    last = Cells.SpecialCells(xlCellTypeLastCell).Row
    Dim serverType As String
    Dim directory As String
    Do Until i > last
        Dim module As String
        module = Trim(Cells(i, 3).Value)
        If module = "" Then Exit Do
        Dim temp As String
        temp = Trim(Cells(i, 1).Value)
        serverType = IIf(temp = "", serverType, temp)
        temp = Trim(Cells(i, 2).Value)
        directory = IIf(temp = "", directory, temp)
        myADOstr.WriteText "RELEASE:" & serverType & ":" & directory & ":" & module & vbLf
        i = i + 1
    Loop

    'ファイル名は適切に指定。後ろの「2」は上書きモード
    myADOstr.SaveToFile name, 2
    myADOstr.Close
    Set myADOstr = Nothing
End Sub

Posted by 동경불나방