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
'테크노오로지' 카테고리의 다른 글
| [Linux]ipcs,pstreeについて (0) | 2010/09/02 |
|---|---|
| CentOS 또는 RHEL에서 CA 인증서와 Server/Client용 인증서 생성하기 (0) | 2010/08/25 |
| Excelマクロ ファイルEUC-JP出力 (0) | 2010/08/23 |
| [Linux]서버간의 전송속도 측정하기 (0) | 2010/06/09 |
| [Linux]패킷 리피터 스톤(stone) (0) | 2010/04/22 |
| [Linux]route設定について (0) | 2010/04/01 |