VBA SQL生成

'CreateTable用　固定値
Const CreateTableBat = "CreateTable.bat"
Const CreateIndexBat = "CreateIndex.bat"
Const CreateSPBat = "CreateSP.bat"
Const CreateBCPBat = "CreateBCP.bat"
Const SheetNameIgnore = "設定・作成"
Const SheetNameHIF = "ホストIF"
Const SheetNameStartRow = 14
Const SheetNameStartCol = 1
Const DbTypeRow = 2
Const InPathRow = 3
Const FilePathRow = 4
Const SuffixRow = 4
Const IdxFilePathRow = 5
Const DbNameRow = 7
Const DbUserRow = 8
Const DbPswdRow = 9
Const DbServerRow = 10
Const BatLogRow = 11

'各テーブル定義書用　固定値
Const SQLCreateRow = 10       '項目開始行
Const ItemNameCol = 3         '項目名カラム
Const ItemIDCol = 10           '項目IDカラム
Const ItemAttributeCol = 18   '項目属性カラム
Const ItemLengthCol = 22      '項目レングスカラム
Const ItemScaleCol = 24       '項目小数点レングスカラム
Const ItemPKeyCol = 28        '主キーカラム
Const ItemNotNullCol = 26     'Not Null制約カラム
Const ItemDefaultCol = 30     '初期値カラム
Const SQLDefinedSheetName = "テーブル"

Const TableNameRow = 7
Const TableNameCol = 18
Const FileGroupRow = 7
Const FileGroupCol = 26

'ブック名チェック
Function BookCheck(pathName As String, bookName As String) As Integer

On Error GoTo BookCheckError
Dim sheetName As String

BookCheck = 0

If bookName = "CreateSQL.xls" Then
    BookCheck = 1
    Exit Function
End If

If InStr(1, bookName, ".xls") = 0 Then
    BookCheck = 1
    Exit Function
End If

'sheetName = Mid(bookName, 1, InStr(1, bookName, ".xls") - 1)
'Application.Workbooks.Open pathName + bookName, , True
'Workbooks(bookName).Worksheets(sheetName).Activate
'Workbooks(bookName).Close False

Exit Function

BookCheckError:
    If (Err = 9) Then
      BookCheck = 1
      Workbooks(bookName).Close
      Exit Function
    End If
End Function
'ブック名チェック
Function BookCheck2(pathName As String, bookName As String, suffix As String) As Integer

On Error GoTo BookCheck2Error
Dim sheetName As String

BookCheck2 = 0

If InStr(1, UCase(bookName), suffix) = 0 Then
    BookCheck2 = 1
    Exit Function
End If

Exit Function

BookCheck2Error:
    If (Err = 9) Then
      BookCheck2 = 1
      Exit Function
    End If
End Function

'ブック名チェック
Function BookCheck3(pathName As String, bookName As String, pos As Integer) As Integer

On Error GoTo BookCheck3Error
Dim sheetName As String

BookCheck3 = 0

If bookName = "CreateSQL.xls" Then
    BookCheck3 = 1
    Exit Function
End If

If InStr(1, bookName, ".xls") = 0 Then
    BookCheck3 = 1
    Exit Function
End If

sheetName = Mid(bookName, 1, InStr(1, bookName, ".xls") - 1)
Application.Workbooks.Open pathName + bookName, , True
Workbooks(bookName).Worksheets(sheetName).Activate
If (Worksheets(sheetName).Cells(18, 27) <> "ホストインターフェイス情報") Then
    BookCheck3 = 1
Else
    If (Worksheets(sheetName).Cells(8, 16) <> "ホストIF情報") Then
        Workbooks("CreateSQL.xls").Worksheets("ホストIF").Cells(pos, 2) = "旧フォーマットのレイアウトです、削除フラグは各テーブルレイアウトに定義してください"
    End If
End If

Workbooks(bookName).Close False

Exit Function

BookCheck3Error:
    If (Err = 9) Then
      BookCheck3 = 1
      Workbooks(bookName).Close
      Exit Function
    End If
End Function
'BCP検索
Sub BCPLineUp()

Dim mstrDirStack() As String
Dim lngDirNum() As Long
Dim lngDirPointer() As Long
Dim strDirName As String
Dim strDirReturn As String

lngDirCnt1 = 0
lngDirCnt2 = 0
lngDirCnt3 = 0
blnDirExistFlag = False
strFolderName = Cells(InPathRow, 2)

Worksheets("BCP作成").Range("A" & Mid(Str(SheetNameStartRow), 2) & ":A2000").Clear

ReDim Preserve mstrDirStack(lngDirCnt1)
mstrDirStack(lngDirCnt1) = strFolderName
lngDirCnt1 = lngDirCnt1 + 1
ReDim Preserve lngDirNum(lngDirCnt2)
lngDirNum(lngDirCnt2) = lngDirCnt1
lngDirCnt2 = lngDirCnt2 + 1
ReDim Preserve lngDirPointer(lngDirCnt3)
lngDirPointer(lngDirCnt3) = lngDirCnt1
lngDirCnt3 = lngDirCnt3 + 1

i = 0
strDirName = strFolderName & "\"
strDirReturn = Dir(strDirName, vbDirectory)
Do While strDirReturn <> ""
  If strDirReturn <> "." And strDirReturn <> ".." Then
    If (GetAttr(strDirName & strDirReturn) And vbDirectory) = vbDirectory Then
      blnDirExistFlag = True
      ReDim Preserve mstrDirStack(lngDirCnt1)
      mstrDirStack(lngDirCnt1) = strDirName & strDirReturn
      lngDirCnt1 = lngDirCnt1 + 1
    Else
        If (BookCheck2(strDirName, strDirReturn, UCase(Worksheets("BCP作成").Cells(SuffixRow, 2))) = 0) Then
            Cells(SheetNameStartRow + i, SheetNameStartCol) = strDirName + strDirReturn
            i = i + 1
        End If
    End If
  End If
  strDirReturn = Dir
Loop

If blnDirExistFlag = True Then
  ReDim Preserve lngDirNum(lngDirCnt2)
  lngDirNum(lngDirCnt2) = lngDirCnt1
  lngDirCnt2 = lngDirCnt2 + 1
  ReDim Preserve lngDirPointer(lngDirCnt3)
  lngDirPointer(lngDirCnt3) = lngDirCnt1
  lngDirCnt3 = lngDirCnt3 + 1
Else
  Exit Sub
End If

Do
  blnDirExistFlag = False
  If lngDirCnt3 = 1 Then
    lngDirStart = 0
  Else
    lngDirStart = lngDirPointer(lngDirCnt3 - 2)
  End If

  For lngFor_Cnt = lngDirStart To lngDirPointer(lngDirCnt3 - 1) - 1
    strDirName = mstrDirStack(lngFor_Cnt) & "\"
    strDirReturn = Dir(strDirName, vbDirectory)
    Do While strDirReturn <> ""
      If strDirReturn <> "." And strDirReturn <> ".." Then
        If (GetAttr(strDirName & strDirReturn) And vbDirectory) = vbDirectory Then
          blnDirExistFlag = True
          ReDim Preserve mstrDirStack(lngDirCnt1)
          mstrDirStack(lngDirCnt1) = strDirName & strDirReturn
          lngDirCnt1 = lngDirCnt1 + 1
        Else
          If (BookCheck2(strDirName, strDirReturn, UCase(Worksheets("BCP作成").Cells(SuffixRow, 2))) = 0) Then
            Cells(SheetNameStartRow + i, SheetNameStartCol) = strDirName + strDirReturn
            i = i + 1
          End If
        End If
      End If
      strDirReturn = Dir
    Loop

    If lngDirCnt1 <> 0 Then
      ReDim Preserve lngDirNum(lngDirCnt2)
      lngDirNum(lngDirCnt2) = lngDirCnt1
        lngDirCnt2 = lngDirCnt2 + 1
    End If
  Next lngFor_Cnt

  If blnDirExistFlag = True Then
    ReDim Preserve lngDirPointer(lngDirCnt3)
    lngDirPointer(lngDirCnt3) = lngDirCnt1
    lngDirCnt3 = lngDirCnt3 + 1
  End If
Loop While blnDirExistFlag = True

End Sub
'SP検索
Sub SPLineUp()

Dim mstrDirStack() As String
Dim lngDirNum() As Long
Dim lngDirPointer() As Long
Dim strDirName As String
Dim strDirReturn As String

lngDirCnt1 = 0
lngDirCnt2 = 0
lngDirCnt3 = 0
blnDirExistFlag = False
strFolderName = Cells(InPathRow, 2)

Worksheets("バッチ作成").Range("A" & Mid(Str(SheetNameStartRow), 2) & ":A2000").Clear

ReDim Preserve mstrDirStack(lngDirCnt1)
mstrDirStack(lngDirCnt1) = strFolderName
lngDirCnt1 = lngDirCnt1 + 1
ReDim Preserve lngDirNum(lngDirCnt2)
lngDirNum(lngDirCnt2) = lngDirCnt1
lngDirCnt2 = lngDirCnt2 + 1
ReDim Preserve lngDirPointer(lngDirCnt3)
lngDirPointer(lngDirCnt3) = lngDirCnt1
lngDirCnt3 = lngDirCnt3 + 1

i = 0
strDirName = strFolderName & "\"
strDirReturn = Dir(strDirName, vbDirectory)
Do While strDirReturn <> ""
  If strDirReturn <> "." And strDirReturn <> ".." Then
    If (GetAttr(strDirName & strDirReturn) And vbDirectory) = vbDirectory Then
      blnDirExistFlag = True
      ReDim Preserve mstrDirStack(lngDirCnt1)
      mstrDirStack(lngDirCnt1) = strDirName & strDirReturn
      lngDirCnt1 = lngDirCnt1 + 1
    Else
        If (BookCheck2(strDirName, strDirReturn, UCase(Worksheets("バッチ作成").Cells(SuffixRow, 2))) = 0) Then
            Cells(SheetNameStartRow + i, SheetNameStartCol) = strDirName + strDirReturn
            i = i + 1
        End If
    End If
  End If
  strDirReturn = Dir
Loop

If blnDirExistFlag = True Then
  ReDim Preserve lngDirNum(lngDirCnt2)
  lngDirNum(lngDirCnt2) = lngDirCnt1
  lngDirCnt2 = lngDirCnt2 + 1
  ReDim Preserve lngDirPointer(lngDirCnt3)
  lngDirPointer(lngDirCnt3) = lngDirCnt1
  lngDirCnt3 = lngDirCnt3 + 1
Else
  Exit Sub
End If

Do
  blnDirExistFlag = False
  If lngDirCnt3 = 1 Then
    lngDirStart = 0
  Else
    lngDirStart = lngDirPointer(lngDirCnt3 - 2)
  End If

  For lngFor_Cnt = lngDirStart To lngDirPointer(lngDirCnt3 - 1) - 1
    strDirName = mstrDirStack(lngFor_Cnt) & "\"
    strDirReturn = Dir(strDirName, vbDirectory)
    Do While strDirReturn <> ""
      If strDirReturn <> "." And strDirReturn <> ".." Then
        If (GetAttr(strDirName & strDirReturn) And vbDirectory) = vbDirectory Then
          blnDirExistFlag = True
          ReDim Preserve mstrDirStack(lngDirCnt1)
          mstrDirStack(lngDirCnt1) = strDirName & strDirReturn
          lngDirCnt1 = lngDirCnt1 + 1
        Else
          If (BookCheck2(strDirName, strDirReturn, UCase(Worksheets("バッチ作成").Cells(SuffixRow, 2))) = 0) Then
            Cells(SheetNameStartRow + i, SheetNameStartCol) = strDirName + strDirReturn
            i = i + 1
          End If
        End If
      End If
      strDirReturn = Dir
    Loop

    If lngDirCnt1 <> 0 Then
      ReDim Preserve lngDirNum(lngDirCnt2)
      lngDirNum(lngDirCnt2) = lngDirCnt1
        lngDirCnt2 = lngDirCnt2 + 1
    End If
  Next lngFor_Cnt

  If blnDirExistFlag = True Then
    ReDim Preserve lngDirPointer(lngDirCnt3)
    lngDirPointer(lngDirCnt3) = lngDirCnt1
    lngDirCnt3 = lngDirCnt3 + 1
  End If
Loop While blnDirExistFlag = True

End Sub
'実行！！
Sub AllSheetsMakeBCP()
createTable = False

LogPath = Worksheets("BCP作成").Cells(BatLogRow, 2)
FilePath = Worksheets("BCP作成").Cells(InPathRow, 2)

If FilePath = "" Then
    If MsgBox("出力ファイルパスが書かれていません", vbOKOnly + vbCritical, "Create Insert SQL") = vbOK Then
        Worksheets("BCP作成").Cells(FilePathRow, 2).Select
        Exit Sub
    End If
End If
If (Dir(FilePath, vbDirectory) = "") Then
   ExecCommand "cmd.exe /c mkdir " + FilePath
End If
S = 0

SQLSheetName = Worksheets("BCP作成").Cells(SheetNameStartRow + S, 1)
While SQLSheetName <> ""
    pos = InStrRev(SQLSheetName, "\")
    bookName = Mid(Mid(SQLSheetName, pos + 1), 1, Len(Mid(SQLSheetName, pos + 1)) - 4)
   
    If (S = 0) Then
        Filename = FilePath & "\" & CreateBCPBat
        Open Filename For Output As #2
        Print #2, "echo BCP作成 > " & LogPath
        Print #2, ""
        Print #2, "cd /d " & FilePath
        Print #2, ""
        Print #2, "set DBNAME=" & Worksheets("BCP作成").Cells(DbNameRow, 2)
        Print #2, "set UNAME=" & Worksheets("BCP作成").Cells(DbUserRow, 2)
        Print #2, "set PNAME=" & Worksheets("BCP作成").Cells(DbPswdRow, 2)
        Print #2, "set SNAME=" & Worksheets("BCP作成").Cells(DbServerRow, 2)
    End If

    If (Worksheets("BCP作成").Cells(6, 2) = "TI") Then
        Print #2, "isql -U%UNAME% -P%PNAME% -S%SNAME% -d%DBNAME% -Q""truncate table " & bookName & """"
    End If
    Print #2, "bcp " & Worksheets("BCP作成").Cells(DbNameRow, 2) & ".." & bookName & " in " & SQLSheetName & " -U%UNAME% -P%PNAME% -S%SNAME% -c -b50000 >> " & LogPath
    Print #2, ""

    S = S + 1
    SQLSheetName = Worksheets("BCP作成").Cells(SheetNameStartRow + S, 1)
Wend
Worksheets("BCP作成").Activate
Print #2, "pause"
Print #2, ""
Close #2

AllSheetsMakeBCP_1:

If (rcd >= 0) Then
    MsgBox "ちゃんと出来ました。"
End If
End Sub
'実行！！
Sub AllSheetsMakeSP()
createTable = False

LogPath = Worksheets("バッチ作成").Cells(BatLogRow, 2)
FilePath = Worksheets("バッチ作成").Cells(InPathRow, 2)

If FilePath = "" Then
    If MsgBox("出力ファイルパスが書かれていません", vbOKOnly + vbCritical, "Create Insert SQL") = vbOK Then
        Worksheets("バッチ作成").Cells(FilePathRow, 2).Select
        Exit Sub
    End If
End If
S = 0
If (Dir(FilePath, vbDirectory) = "") Then
   ExecCommand "cmd.exe /c mkdir " + FilePath
End If

SQLSheetName = Worksheets("バッチ作成").Cells(SheetNameStartRow + S, 1)
While SQLSheetName <> ""
    pos = InStrRev(SQLSheetName, "\")
    bookName = Mid(SQLSheetName, pos + 1)
    sheetName = Mid(bookName, 1, InStr(1, UCase(bookName), UCase(Worksheets("バッチ作成").Cells(SuffixRow, 2))) - 1)
   
    'CreateTable.bat作成
    If (createTable = False) Then
        Filename = FilePath & "\" & CreateSPBat
        Open Filename For Output As #2
        Print #2, "echo テーブル作成 > " & LogPath
        Print #2, ""
        Print #2, "cd /d " & FilePath
        Print #2, ""
        Print #2, "set DBNAME=" & Worksheets("バッチ作成").Cells(DbNameRow, 2)
        Print #2, "set UNAME=" & Worksheets("バッチ作成").Cells(DbUserRow, 2)
        Print #2, "set PNAME=" & Worksheets("バッチ作成").Cells(DbPswdRow, 2)
        Print #2, "set SNAME=" & Worksheets("バッチ作成").Cells(DbServerRow, 2)
        Print #2, ""
        createTable = True
    End If
    Print #2, "echo " & sheetName & Worksheets("バッチ作成").Cells(SuffixRow, 2) & " >> " & LogPath
    Print #2, "isql -U%UNAME% -P%PNAME% -S%SNAME% -d%DBNAME% -i" & SQLSheetName & ">> " & LogPath
    Print #2, "echo " & sheetName & Worksheets("バッチ作成").Cells(SuffixRow, 2) & " >> " & LogPath
    Print #2, ""

    S = S + 1
    SQLSheetName = Worksheets("バッチ作成").Cells(SheetNameStartRow + S, 1)
Wend
Worksheets("バッチ作成").Activate
Print #2, "pause"
Print #2, ""
Close #2

AllSheetsMakeSP_1:

If (rcd >= 0) Then
    MsgBox "ちゃんと出来ました。"
End If
End Sub

'シート検索
Sub SheetNamesLineUp()

Dim mstrDirStack() As String
Dim lngDirNum() As Long
Dim lngDirPointer() As Long
Dim strDirName As String
Dim strDirReturn As String

lngDirCnt1 = 0
lngDirCnt2 = 0
lngDirCnt3 = 0
blnDirExistFlag = False
strFolderName = Cells(InPathRow, 2)

Worksheets(SheetNameIgnore).Range("A" & Mid(Str(SheetNameStartRow), 2) & ":A2000").Clear

ReDim Preserve mstrDirStack(lngDirCnt1)
mstrDirStack(lngDirCnt1) = strFolderName
lngDirCnt1 = lngDirCnt1 + 1
ReDim Preserve lngDirNum(lngDirCnt2)
lngDirNum(lngDirCnt2) = lngDirCnt1
lngDirCnt2 = lngDirCnt2 + 1
ReDim Preserve lngDirPointer(lngDirCnt3)
lngDirPointer(lngDirCnt3) = lngDirCnt1
lngDirCnt3 = lngDirCnt3 + 1

i = 0
strDirName = strFolderName & "\"
strDirReturn = Dir(strDirName, vbDirectory)
Do While strDirReturn <> ""
  If strDirReturn <> "." And strDirReturn <> ".." Then
    If (GetAttr(strDirName & strDirReturn) And vbDirectory) = vbDirectory Then
      blnDirExistFlag = True
      ReDim Preserve mstrDirStack(lngDirCnt1)
      mstrDirStack(lngDirCnt1) = strDirName & strDirReturn
      lngDirCnt1 = lngDirCnt1 + 1
    Else
        If (BookCheck(strDirName, strDirReturn) = 0) Then
            Cells(SheetNameStartRow + i, SheetNameStartCol) = strDirName + strDirReturn
            i = i + 1
        End If
    End If
  End If
  strDirReturn = Dir
Loop

If blnDirExistFlag = True Then
  ReDim Preserve lngDirNum(lngDirCnt2)
  lngDirNum(lngDirCnt2) = lngDirCnt1
  lngDirCnt2 = lngDirCnt2 + 1
  ReDim Preserve lngDirPointer(lngDirCnt3)
  lngDirPointer(lngDirCnt3) = lngDirCnt1
  lngDirCnt3 = lngDirCnt3 + 1
Else
  Exit Sub
End If

Do
  blnDirExistFlag = False
  If lngDirCnt3 = 1 Then
    lngDirStart = 0
  Else
    lngDirStart = lngDirPointer(lngDirCnt3 - 2)
  End If

  For lngFor_Cnt = lngDirStart To lngDirPointer(lngDirCnt3 - 1) - 1
    strDirName = mstrDirStack(lngFor_Cnt) & "\"
    strDirReturn = Dir(strDirName, vbDirectory)
    Do While strDirReturn <> ""
      If strDirReturn <> "." And strDirReturn <> ".." Then
        If (GetAttr(strDirName & strDirReturn) And vbDirectory) = vbDirectory Then
          blnDirExistFlag = True
          ReDim Preserve mstrDirStack(lngDirCnt1)
          mstrDirStack(lngDirCnt1) = strDirName & strDirReturn
          lngDirCnt1 = lngDirCnt1 + 1
        Else
          If (BookCheck(strDirName, strDirReturn) = 0) Then
            Cells(SheetNameStartRow + i, SheetNameStartCol) = strDirName + strDirReturn
            i = i + 1
          End If
        End If
      End If
      strDirReturn = Dir
    Loop

    If lngDirCnt1 <> 0 Then
      ReDim Preserve lngDirNum(lngDirCnt2)
      lngDirNum(lngDirCnt2) = lngDirCnt1
        lngDirCnt2 = lngDirCnt2 + 1
    End If
  Next lngFor_Cnt

  If blnDirExistFlag = True Then
    ReDim Preserve lngDirPointer(lngDirCnt3)
    lngDirPointer(lngDirCnt3) = lngDirCnt1
    lngDirCnt3 = lngDirCnt3 + 1
  End If
Loop While blnDirExistFlag = True

End Sub
'実行！！
Sub AllSheetsMakeCreateSQL()
createTable = False
createIndex = False
Dim idxLogPath As String
Dim findDotIndex As Integer
Dim bookError As Integer
Dim bookErrorCnt As Integer
Dim bookErrorName As String

On Error GoTo AllSheetsMakeCreateSQLError

bookErrorName = ""
bookError = 0
bookErrorCnt = 0

LogPath = Worksheets(SheetNameIgnore).Cells(BatLogRow, 2)

If LogPath = "" Then
    If MsgBox("ログファイルパスが書かれていません", vbOKOnly + vbCritical, "Create Insert SQL") = vbOK Then
        Worksheets(SheetNameIgnore).Cells(BatLogRow, 2).Select
        Exit Sub
    End If
End If

idxLogPath = LogPath 'インデックスのログファイルパスとファイル名を設定。
findDotIndex = InStrRev(idxLogPath, ".")

If findDotIndex > 0 Then
    '"."が見つかった場合
    idxLogPath = (Left(idxLogPath, findDotIndex - 1) & "Index" & Right(idxLogPath, Len(idxLogPath) - findDotIndex + 1))
Else
    ' "."が見つからない場合
    idxLogPath = idxLogPath & "Index"
End If



FilePath = Worksheets(SheetNameIgnore).Cells(FilePathRow, 2)
IdxFilePath = Worksheets(SheetNameIgnore).Cells(IdxFilePathRow, 2)

If (Dir(FilePath, vbDirectory) = "") Then
   ExecCommand "cmd.exe /c mkdir " + FilePath
End If
If (Dir(IdxFilePath, vbDirectory) = "") Then
   ExecCommand "cmd.exe /c mkdir " + IdxFilePath
End If

If FilePath = "" Then
    If MsgBox("出力ファイルパスが書かれていません", vbOKOnly + vbCritical, "Create Insert SQL") = vbOK Then
        Worksheets(SheetNameIgnore).Cells(FilePathRow, 2).Select
        Exit Sub
    End If
End If
S = 0

SQLSheetName = Worksheets(SheetNameIgnore).Cells(SheetNameStartRow + S, 1)
While SQLSheetName <> ""

AllSheetsMakeCreateSQL_2:
   
    pos = InStrRev(SQLSheetName, "\")
    bookName = Mid(SQLSheetName, pos + 1)
    'sheetName = Mid(bookName, 1, InStr(1, bookName, ".xls") - 1)
    sheetName = SQLDefinedSheetName
    Application.Workbooks.Open SQLSheetName, , True
    bookError = 1
    Workbooks(bookName).Worksheets(sheetName).Activate
    If bookError = 2 Then
        S = S + 1
        SQLSheetName = Worksheets(SheetNameIgnore).Cells(SheetNameStartRow + S, 1)
        GoTo AllSheetsMakeCreateSQL_2
    End If
    bookError = 0
    'SQL作成
    rcd = MakeCreateSQL(FilePath, IdxFilePath, sheetName)
    If (rcd < 0) Then GoTo AllSheetsMakeCreateSQL_1
    Workbooks(bookName).Close False
    S = S + 1
    SQLSheetName = Worksheets(SheetNameIgnore).Cells(SheetNameStartRow + S, 1)
   
    'CreateTable.bat作成
    If (createTable = False) Then
        Filename = FilePath & "\" & CreateTableBat
        Open Filename For Output As #2
        Print #2, "echo テーブル作成 > " & LogPath
        Print #2, ""
        Print #2, "cd /d " & FilePath
        Print #2, ""
        Print #2, "set DBNAME=" & Worksheets(SheetNameIgnore).Cells(DbNameRow, 2)
        Print #2, "set UNAME=" & Worksheets(SheetNameIgnore).Cells(DbUserRow, 2)
        Print #2, "set PNAME=" & Worksheets(SheetNameIgnore).Cells(DbPswdRow, 2)
        Print #2, "set SNAME=" & Worksheets(SheetNameIgnore).Cells(DbServerRow, 2)
        Print #2, ""
        createTable = True
    End If
    Print #2, "echo " & sheetName & ".sql >> " & LogPath
    Print #2, "isql -U%UNAME% -P%PNAME% -S%SNAME% -d%DBNAME% -i" & sheetName & ".sql >> " & LogPath
    Print #2, "echo " & sheetName & ".sql >> " & LogPath
    Print #2, ""

    'CreateIndex.bat作成
    If rcd = 1 Then
        If (createIndex = False) Then
            Filename = IdxFilePath & "\" & CreateIndexBat
            Open Filename For Output As #3
            Print #3, "echo インデックス作成 > " & idxLogPath
            Print #3, ""
            Print #3, "cd /d " & IdxFilePath
            Print #3, ""
            Print #3, "set DBNAME=" & Worksheets(SheetNameIgnore).Cells(DbNameRow, 2)
            Print #3, "set UNAME=" & Worksheets(SheetNameIgnore).Cells(DbUserRow, 2)
            Print #3, "set PNAME=" & Worksheets(SheetNameIgnore).Cells(DbPswdRow, 2)
            Print #3, "set SNAME=" & Worksheets(SheetNameIgnore).Cells(DbServerRow, 2)
            Print #3, ""
            createIndex = True
        End If
        Print #3, "echo index_" & sheetName & ".sql >> " & idxLogPath
        Print #3, "isql -U%UNAME% -P%PNAME% -S%SNAME% -d%DBNAME% -iindex_" & sheetName & ".sql >> " & idxLogPath
        Print #3, "echo index_" & sheetName & ".sql >> " & idxLogPath
        Print #3, ""
    End If
Wend
Worksheets(SheetNameIgnore).Activate
Print #2, "pause"
Print #2, ""
Close #2
If (createIndex = True) Then
Print #3, "pause"
Print #3, ""
End If
Close #3

AllSheetsMakeCreateSQL_1:

If (rcd >= 0) Then
    If (bookErrorCnt > 0) Then
        MsgBox bookErrorName + "だけ、作成に失敗しました。"
    Else
        MsgBox "ちゃんと出来ました。"
    End If
Else
    MsgBox "ちゃんと出来ませんでした。"
End If

Exit Sub

AllSheetsMakeCreateSQLError:
    If (Err = 9 And bookError = 1) Then
      Workbooks(bookName).Close
      bookError = 2
      bookErrorCnt = bookErrorCnt + 1
      If bookErrorName <> "" Then
          bookErrorName = bookErrorName + "," + bookName
      Else
          bookErrorName = bookName
      End If
      Resume Next
    Else
        MsgBox bookName + "作成中にエラー" + Error(Err) + Str(Err)
    End If
End Sub

'SQLの作成
Function MakeCreateSQL(FilePath, IdxFilePath, SQLSheetName) As Integer
Dim pry As Integer
MakeCreateSQL = 0
ColID = ""
ColAtt = ""
ColLen = ""
ColScaleLen = ""
CreateCol = ""
CreateCol2 = ""
ColNotNull = ""
ColDefault = ""
ColPKey = ""
ColIdentity = ""

TableName = ""
TableName_hist = ""
CreateSQL = ""
DropSQL = ""

'テーブル名
TableName = Worksheets(SQLSheetName).Cells(TableNameRow, TableNameCol)

'ファイルグループ名
FileGroup = Worksheets(SQLSheetName).Cells(FileGroupRow, FileGroupCol)
If InStr(1, FileGroup, "/") <> 0 Then
    FileGroupIdx = Mid(FileGroup, InStr(1, FileGroup, "/") + 1, Len(FileGroup))
    FileGroup = Mid(FileGroup, 1, InStr(1, FileGroup, "/") - 1)
Else
    FileGroupIdx = FileGroup
End If

'ファイル名
Filename = FilePath & "\" & TableName & ".sql"
Open Filename For Output As #1

'主キー
'ColPKey = ColPKey & FindCell(0, pry)
ColPKey = SetPrimaryKey()

CreateSQL = ""
DolopSQL = ""
For i = SQLCreateRow To 65535
  '項目IDが設定されている場合
  If Worksheets(SQLSheetName).Cells(i, ItemIDCol) <> "" Then
    If Len(Worksheets(SQLSheetName).Cells(i, ItemIDCol)) > 30 Then
        Worksheets(SQLSheetName).Cells(i, ItemIDCol).Select
        rcd = MsgBox("３０文字って決めたんだから守りましょう" + Chr(13) + Chr(13) + Worksheets(SQLSheetName).Cells(i, ItemNameCol) + Chr(13) + Worksheets(SQLSheetName).Cells(i, ItemIDCol) + Chr(13) + Chr(13) + "間違ってる所にカーソルがあるから、直しなさい", vbOKOnly)
        Close #1
        MakeCreateSQL = -1
        Exit Function
    End If

    '項目名
    colname = Worksheets(SQLSheetName).Cells(i, ItemNameCol)
    '項目ID
    ColID = Worksheets(SQLSheetName).Cells(i, ItemIDCol)
    '属性
    ColAtt = Worksheets(SQLSheetName).Cells(i, ItemAttributeCol)
    '有効桁数
    ColLen = Worksheets(SQLSheetName).Cells(i, ItemLengthCol)
    '小数桁数
    ColScaleLen = Worksheets(SQLSheetName).Cells(i, ItemScaleCol)
    'Not Null
    ColNotNull = ""
    If Worksheets(SQLSheetName).Cells(i, ItemNotNullCol) = "Y" Then
      ColNotNull = " NOT NULL"
    End If
    '初期値
    ColIdentity = ""
    ColDefault = Worksheets(SQLSheetName).Cells(i, ItemDefaultCol)
    If ColDefault <> BLANK Or ColDefault = "0" Then
      'If Left(ColDefault, 1) = """" And Right(ColDefault, 1) = """" Then
      If Left(ColDefault, 1) = "'" And Right(ColDefault, 1) = "'" Then
        Select Case VBA.UCase(ColAtt)
          Case "CHAR"
            ColDefault = "'" & String(ColLen, " ") & "'"
          'Case "VARCHAR"
          Case Else
            ColDefault = "''"
        End Select
      Else
        If InStr(1, ColAtt, "CHAR") <> 0 Then
           If (UCase(ColDefault) <> "NULL") Then
              ColDefault = "'" & ColDefault & "'"
           End If
        End If
      End If
      If InStr(1, ColDefault, "IDENTITY") <> 0 Then
          ColIdentity = " " & ColDefault
          ColDefault = ""
      Else
          ColDefault = " DEFAULT " & ColDefault
      End If
    End If

    'カラム作成情報の構築
    CreateRow = ""
    CreateRow2 = ""
   
    Select Case VBA.UCase(ColAtt)
      Case "INT"
        CreateRow = ColID & " " & ColAtt & ColIdentity & ColDefault & ColNotNull
        CreateRow2 = ColID & " " & ColAtt & ColDefault & ColNotNull
      Case "BIGINT"
        CreateRow = ColID & " " & ColAtt & ColIdentity & ColDefault & ColNotNull
        CreateRow2 = ColID & " " & ColAtt & ColDefault & ColNotNull
      Case "SMALLINT"
        CreateRow = ColID & " " & ColAtt & ColIdentity & ColDefault & ColNotNull
        CreateRow2 = ColID & " " & ColAtt & ColDefault & ColNotNull
      Case "TINYINT"
        CreateRow = ColID & " " & ColAtt & ColIdentity & ColDefault & ColNotNull
        CreateRow2 = ColID & " " & ColAtt & ColDefault & ColNotNull
      Case "DECIMAL"
        CreateRow = ColID & " " & ColAtt & "(" & ColLen & "," & ColScaleLen & ")" & ColIdentity & ColDefault & ColNotNull
        CreateRow2 = ColID & " " & ColAtt & "(" & ColLen & "," & ColScaleLen & ")" & ColDefault & ColNotNull
      Case "MONEY"
        CreateRow = ColID & " " & ColAtt & ColNotNull & ColIdentity & ColDefault
        CreateRow2 = ColID & " " & ColAtt & ColDefault & ColNotNull
      Case "DATETIME"
        CreateRow = ColID & " " & ColAtt & ColDefault & ColNotNull
        CreateRow2 = ColID & " " & ColAtt & ColDefault & ColNotNull
      Case "DATE"
        CreateRow = ColID & " " & ColAtt & ColDefault & ColNotNull
        CreateRow2 = ColID & " " & ColAtt & ColDefault & ColNotNull
      Case "CHAR"
        CreateRow = ColID & " " & ColAtt & "(" & ColLen & ")" & ColDefault & ColNotNull
        CreateRow2 = ColID & " " & ColAtt & "(" & ColLen & ")" & ColDefault & ColNotNull
      Case "VARCHAR"
        CreateRow = ColID & " " & ColAtt & "(" & ColLen & ")" & ColDefault & ColNotNull
        CreateRow2 = ColID & " " & ColAtt & "(" & ColLen & ")" & ColDefault & ColNotNull
      Case "VARCHAR2"
        CreateRow = ColID & " " & ColAtt & "(" & ColLen & ")" & ColDefault & ColNotNull
        CreateRow2 = ColID & " " & ColAtt & "(" & ColLen & ")" & ColDefault & ColNotNull
      Case "NVARCHAR2"
        CreateRow = ColID & " " & ColAtt & "(" & ColLen & ")" & ColDefault & ColNotNull
        CreateRow2 = ColID & " " & ColAtt & "(" & ColLen & ")" & ColDefault & ColNotNull
      Case "NVARCHAR"
        CreateRow = ColID & " " & ColAtt & "(" & ColLen & ")" & ColDefault & ColNotNull
        CreateRow2 = ColID & " " & ColAtt & "(" & ColLen & ")" & ColDefault & ColNotNull
      Case "NUMBER"
        CreateRow = ColID & " " & ColAtt & "(" & ColLen & ")" & ColDefault & ColNotNull
        CreateRow2 = ColID & " " & ColAtt & "(" & ColLen & ")" & ColDefault & ColNotNull
      Case "TIMESTAMP"
        CreateRow = ColID & " " & ColAtt & ColDefault & ColNotNull
        CreateRow2 = ColID & " " & ColAtt & ColDefault & ColNotNull
      Case "IMAGE"
        CreateRow = ColID & " " & ColAtt & ColNotNull
        CreateRow2 = ColID & " " & ColAtt & ColNotNull
     End Select
    
     CreateRow = Chr(9) & CreateRow & "," & Chr(13) & Chr(10)
     CreateRow2 = Chr(9) & CreateRow2 & "," & Chr(13) & Chr(10)
  
     CreateCol = CreateCol & CreateRow
     CreateCol2 = CreateCol2 & CreateRow2
  Else
    i = 9999999 'スペースカラムで終了とする
  End If

Next i
 
'テーブル名
TableName = Worksheets(SQLSheetName).Cells(TableNameRow, TableNameCol)

Comment = "COMMENT ON TABLE KAMSSERVICE." & TableName & " IS '" & Worksheets(SQLSheetName).Cells(7, 1) & "'" & Chr(13) & Chr(10)
For i = SQLCreateRow To 65535
  '項目名
  colname = Worksheets(SQLSheetName).Cells(i, ItemNameCol)
  '項目ID
    ColID = Worksheets(SQLSheetName).Cells(i, ItemIDCol)
  '項目IDが設定されている場合
  If Worksheets(SQLSheetName).Cells(i, ItemIDCol) <> "" Then
     Comment = Comment + "/" & Chr(13) & Chr(10) & "COMMENT ON COLUMN KAMSSERVICE." & TableName & "." & ColID & " IS '" & colname & "'" & Chr(13) & Chr(10)
  Else
    i = 9999999 'スペースカラムで終了とする
  End If

Next i

'Print #1, "/* " & Worksheets(SQLSheetName).Cells(TableNameRow - 1, TableNameCol) & " */"
'Drop文作成
'Print #1, "if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[" & TableName & "]') and OBJECTPROPERTY(id, N'IsUserTable') = 1)"
'DropSQL = "DROP TABLE [dbo].[" & TableName & "]"
'Print #1, Chr(9) & DropSQL
'Print #1, "GO"
'Print #1, ""

'Create文最終構築
CreateSQL = ""
'Print #1, "CREATE TABLE dbo." & TableName & "("
Print #1, "CREATE TABLE " & TableName & "("

'項目情報 & 主キー情報
If ColPKey <> "" Then
  CreateSQL = CreateCol & "PRIMARY KEY(" & ColPKey & ")"
Else
  CreateSQL = CreateCol
End If

Print #1, CreateSQL & ")" & Chr(13) & Chr(10) & "/" & Chr(13) & Chr(10) & Comment & "/"

' 主キー情報
'If ColPKey <> "" Then
'  Print #1, "ON [" & FileGroup & "]"
'End If
'Print #1, "GO"

' 変更履歴対象テーブル
If Worksheets(SQLSheetName).Cells(7, 21) = "○" Then
    'テーブル名
    TableName_hist = Worksheets(SQLSheetName).Cells(TableNameRow, TableNameCol) + "_hist"
   
    'Drop文作成
    Print #1, "if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[" & TableName_hist & "]') and OBJECTPROPERTY(id, N'IsUserTable') = 1)"
    DropSQL = "DROP TABLE [dbo].[" & TableName_hist & "]"
    Print #1, Chr(9) & DropSQL
    Print #1, "GO"
    Print #1, ""

    'Create文最終構築
    CreateSQL = ""
    Print #1, "CREATE TABLE dbo." & TableName_hist & "("
    Print #1, Chr(9) + Mid("HistUnique TIMESTAMP NOT NULL," & Space(60), 1, 66) & "/* ユニークキー */"
    Print #1, Chr(9) + Mid("HistStatus CHAR(1) NOT NULL," & Space(60), 1, 66) & "/* 処理内容 */"
   
    CreateSQL = CreateCol2 & "PRIMARY KEY(HistUnique)"

    Print #1, Chr(9) & CreateSQL & ")"
    Print #1, "ON [" & FileGroup & "]"
   
    Print #1, "GO"
End If

'ファイルを閉じる
Close #1

'インデックファイル作成
For i = 1 To 30
    colname = FindCell(i, pry)
    If colname = "" Then
        GoTo MakeCreateSQL_exit
    End If

    indexName = TableName & "_idx" & i
    If i = 1 Then
        Filename = IdxFilePath & "\" & "index_" & TableName & ".sql"
        Open Filename For Output As #1
        Print #1, "--" & Worksheets(SQLSheetName).Cells(TableNameRow - 1, TableNameCol)
        Print #1, "/* $Header: $ */"
    End If
   
    'Drop文作成
    Print #1, "IF EXISTS (SELECT name FROM sysindexes WHERE name = '" & indexName & "')"
    Print #1, Chr(9) & "DROP INDEX " & TableName & "." & indexName
    Print #1, "GO"
    Print #1, ""
    If (pry = 0) Then
        Print #1, "CREATE INDEX " & indexName
    Else
        Print #1, "CREATE UNIQUE NONCLUSTERED INDEX " & indexName
    End If
    Print #1, Chr(9) & "ON " & TableName & " (" & colname & ")"
    Print #1, Chr(9) & "ON [" & FileGroupIdx & "]"
    Print #1, "GO"
    Print #1, ""

    MakeCreateSQL = 1
Next i

MakeCreateSQL_exit:

If i <> 1 Then
    Close #1
End If

End Function

'実行！！
Sub AllSheetsMakeIF()

FilePath = Worksheets(SheetNameHIF).Cells(FilePathRow, 2)

If FilePath = "" Then
    If MsgBox("出力ファイルパスが書かれていません", vbOKOnly + vbCritical, "Create Insert SQL") = vbOK Then
        Worksheets(SheetNameHIF).Cells(FilePathRow, 2).Select
        Exit Sub
    End If
End If
S = 0
If (Dir(FilePath, vbDirectory) = "") Then
   ExecCommand "cmd.exe /c mkdir " + FilePath
End If

SQLSheetName = Worksheets(SheetNameHIF).Cells(SheetNameStartRow + S, 1)
While SQLSheetName <> ""
    '旧フォーマット
    If InStr(Worksheets(SheetNameHIF).Cells(SheetNameStartRow + S, 2), "旧フォーマット") <> 0 Then
        MsgBox "旧フォーマットのレイアウトでは作れません"
        Exit Sub
    End If
    pos = InStrRev(SQLSheetName, "\")
    bookName = Mid(SQLSheetName, pos + 1)
    sheetName = Mid(bookName, 1, InStr(1, bookName, ".xls") - 1)
    Application.Workbooks.Open SQLSheetName, , True
    Workbooks(bookName).Worksheets(sheetName).Activate
    'SQL作成
    rcd = MakeCreateIF(FilePath, sheetName)
'    If Worksheets(SheetNameHIF).Cells(5, 2) = "DownBat" Then
'        rcd = MakeCreateIF(FilePath, sheetName)
'    Else
'        rcd = MakeCreateIFPlus(FilePath, sheetName)
'    End If
    If (rcd < 0) Then GoTo AllSheetsMakeCreateIF_1
    Workbooks(bookName).Close False
    S = S + 1
    SQLSheetName = Worksheets(SheetNameHIF).Cells(SheetNameStartRow + S, 1)
Wend

AllSheetsMakeCreateIF_1:

If (rcd >= 0) Then
    MsgBox "ちゃんと出来ました。"
End If
End Sub
'SQLの作成
Function MakeCreateIF(FilePath, SQLSheetName) As Integer
Dim RowNum(1000) As Integer
MakeCreateIF = -1
ColID = ""
ColAtt = ""
ColLen = ""
ColScaleLen = ""

CreateCol = ""
CreateCol2 = ""
ColNotNull = ""
ColDefault = ""

TableName = ""

'テーブル初期値
IFName = Worksheets(SQLSheetName).Cells(10, 19)
AfterPGM = Worksheets(SQLSheetName).Cells(11, 19)
BackupTBL = Worksheets(SQLSheetName).Cells(12, 19)
CopyTBL = Worksheets(SQLSheetName).Cells(13, 19)
DeleteTBL = Worksheets(SQLSheetName).Cells(14, 19)
ModeUPD = Worksheets(SQLSheetName).Cells(15, 19)
CommitCnt = Trim(Str(Worksheets(SQLSheetName).Cells(16, 19)))
EOFSize = Trim(Str(Worksheets(SQLSheetName).Cells(17, 19)))
TableName = Worksheets(SQLSheetName).Cells(TableNameRow, TableNameCol)
DeleteFlag = Worksheets(SQLSheetName).Cells(9, 19)

'ファイル名
BatFileName = FilePath & "\" & IFName & "bat.xml"
DefFileName = FilePath & "\" & IFName & "def.xml"
DatFileName = FilePath & "\" & IFName & ".dat"
CsvFileName = FilePath & "\" & IFName & ".csv"

'batファイル作成
Open BatFileName For Output As #1
Print #1, "<?xml version=""1.0"" encoding=""Shift-JIS""?>"
Print #1, "<!-- $Header: $ -->"
Print #1, "<BATCHDEF>"
Print #1, Chr(9) + "<ID>" + Worksheets(SQLSheetName).Cells(3, 5) + "</ID>"
If BackupTBL = "○" Then
    Print #1, Chr(9) + "<BACKUPTABLE>" + TableName + "</BACKUPTABLE>"
End If
If CopyTBL = "○" Then
    Print #1, Chr(9) + "<COPYTABLE>" + TableName + "</COPYTABLE>"
End If
If DeleteTBL = "○" Then
    Print #1, Chr(9) + "<DELETETABLE>" + TableName + "</DELETETABLE>"
End If
Print #1, Chr(9) + "<IFS>"
Print #1, Chr(9) + Chr(9) + "<IF>"
Print #1, Chr(9) + Chr(9) + Chr(9) + "<IF_FILE>" + IFName + ".dat</IF_FILE>"
Print #1, Chr(9) + Chr(9) + Chr(9) + "<IF_DEFFILE>" + IFName + "def.xml</IF_DEFFILE>"
Print #1, Chr(9) + Chr(9) + Chr(9) + "<EOFSIZE>" + EOFSize + "</EOFSIZE>"
Print #1, Chr(9) + Chr(9) + "</IF>"
Print #1, Chr(9) + Chr(9) + "<IF>"
Print #1, Chr(9) + Chr(9) + Chr(9) + "<IF_FILE>" + IFName + ".csv</IF_FILE>"
Print #1, Chr(9) + Chr(9) + Chr(9) + "<IF_DEFFILE>" + IFName + "def.xml</IF_DEFFILE>"
Print #1, Chr(9) + Chr(9) + "</IF>"
Print #1, Chr(9) + "</IFS>"
If AfterPGM <> "" Then
    Print #1, Chr(9) + "<PROGRAM>" + AfterPGM + "</PROGRAM>"
End If
Print #1, "</BATCHDEF>"
Close #1

'defファイル作成
Open DefFileName For Output As #1
Print #1, "<?xml version=""1.0"" encoding=""Shift-JIS""?>"
Print #1, "<!-- $Header: $ -->"
Print #1, "<IFDEF>"
Print #1, Chr(9) + "<TABLE>" + TableName + "</TABLE>"
Print #1, Chr(9) + "<COMMITSIZE>" + CommitCnt + "</COMMITSIZE>"
Print #1, Chr(9) + "<MODE>" + ModeUPD + "</MODE>"
Print #1, Chr(9) + "<COLUMNS>"
If DeleteFlag = "○" Then
    Print #1, Chr(9) + Chr(9) + "<COLUMN>"
    Print #1, Chr(9) + Chr(9) + Chr(9) + "<SIZE>1</SIZE>"
    Print #1, Chr(9) + Chr(9) + Chr(9) + "<NAME>DELETEFLAG</NAME>"
    Print #1, Chr(9) + Chr(9) + Chr(9) + "<TYPE>C</TYPE>"
    Print #1, Chr(9) + Chr(9) + "</COLUMN>"
End If
   
RowCnt = 0
For i = 0 To 10000
  '項目IDが設定されている場合
  If Worksheets(SQLSheetName).Cells(i + SQLCreateRow, ItemIDCol) <> "" Then
    RowNum(i + 1) = Worksheets(SQLSheetName).Cells(i + SQLCreateRow, 41)
    RowCnt = RowCnt + 1
  Else
    i = 9999999 'スペースカラムで終了とする
  End If
Next i

nowCnt = 0
endCnt = SQLCreateRow + RowCnt - 1
For i = SQLCreateRow To endCnt

    nowCnt = nowCnt + 1
    nowPos = -1
    For j = 1 To RowCnt
        If RowNum(j) = nowCnt Then
            nowPos = j + SQLCreateRow - 1
            j = 9999999 'スペースカラムで終了とする
        End If
    Next j

    If nowPos < 0 Then
        Print #1, Chr(9) + Chr(9) + "<COLUMN>"
        Print #1, Chr(9) + Chr(9) + Chr(9) + "<NAME>DUMMY</NAME>"
        Print #1, Chr(9) + Chr(9) + "</COLUMN>"
    Else

        '項目ID
        ColID = Worksheets(SQLSheetName).Cells(nowPos, ItemIDCol)
        '属性
        ColAtt2 = Worksheets(SQLSheetName).Cells(nowPos, ItemAttributeCol)
        '有効桁数
        ColLen = Trim(Str(Worksheets(SQLSheetName).Cells(nowPos, 29)))
        '小数桁数
        ColScaleLen = Worksheets(SQLSheetName).Cells(nowPos, ItemScaleCol)
        '初期値
        ColDefault = Worksheets(SQLSheetName).Cells(nowPos, 27)
        '関数名
        ColFunction = Worksheets(SQLSheetName).Cells(nowPos, 31)
        'セット項目
        ColSet = Worksheets(SQLSheetName).Cells(nowPos, 33)
        'MAX項目
        ColMax = Worksheets(SQLSheetName).Cells(nowPos, 35)
        'WHERE項目
        ColWhere = Worksheets(SQLSheetName).Cells(nowPos, 37)
        'GROUP項目
        ColGroup = Worksheets(SQLSheetName).Cells(nowPos, 39)
   
        If ColFunction <> "" Then
            ColAtt = "F"
        Else
            ColAtt = ""
        End If
        Select Case VBA.UCase(ColAtt2)
          Case "INT"
            ColAtt = "N" + ColAtt
          Case "BIGINT"
            ColAtt = "N" + ColAtt
          Case "SMALLINT"
            ColAtt = "N" + ColAtt
          Case "TINYINT"
            ColAtt = "N" + ColAtt
          Case "DECIMAL"
            ColAtt = "N" + ColAtt
          Case "MONEY"
            ColAtt = "N" + ColAtt
            If ColScaleLen = "" Then
                ColScaleLen = "0"
            End If
          Case "DATETIME"
            ColAtt = "D" + ColAtt
          Case "CHAR"
            ColAtt = "C" + ColAtt
          Case "VARCHAR"
            ColAtt = "V" + ColAtt
          Case "TIMESTAMP"
            ColAtt = "C" + ColAtt
          Case "IMAGE"
            ColAtt = "C" + ColAtt
         End Select
   
        Print #1, Chr(9) + Chr(9) + "<COLUMN>"
        If (IsEmpty(ColDummy) Or Trim(ColDummy) = "") Then
            If Not (IsEmpty(ColDefault) Or Trim(ColDefault) = "") Then
                Print #1, Chr(9) + Chr(9) + Chr(9) + "<NAME>" + ColID + "</NAME>"
                Print #1, Chr(9) + Chr(9) + Chr(9) + "<VALUE>" + ColDefault + "</VALUE>"
                If Not (IsEmpty(ColSet) Or Trim(ColSet) = "") Then
                    Print #1, Chr(9) + Chr(9) + Chr(9) + "<SET>Y</SET>"
                End If
            Else
                Print #1, Chr(9) + Chr(9) + Chr(9) + "<SIZE>" + ColLen + "</SIZE>"
                Print #1, Chr(9) + Chr(9) + Chr(9) + "<NAME>" + ColID + "</NAME>"
                Print #1, Chr(9) + Chr(9) + Chr(9) + "<TYPE>" + ColAtt + "</TYPE>"
                If Not (IsEmpty(ColScaleLen) Or Trim(ColScaleLen) = "") Then
                    Print #1, Chr(9) + Chr(9) + Chr(9) + "<DECIMALSIZE>" + Trim(Str(ColScaleLen)) + "</DECIMALSIZE>"
                End If
                If Not (IsEmpty(ColWhere) Or Trim(ColWhere) = "") Then
                    Print #1, Chr(9) + Chr(9) + Chr(9) + "<KEY>Y</KEY>"
                End If
                If Not (IsEmpty(ColFunction) Or Trim(ColFunction) = "") Then
                    Print #1, Chr(9) + Chr(9) + Chr(9) + "<FUNCTION>" + ColFunction + "</FUNCTION>"
                End If
                If Not (IsEmpty(ColMax) Or Trim(ColMax) = "") Then
                    Print #1, Chr(9) + Chr(9) + Chr(9) + "<MAX>Y</MAX>"
                End If
                If Not (IsEmpty(ColGroup) Or Trim(ColGroup) = "") Then
                    Print #1, Chr(9) + Chr(9) + Chr(9) + "<GROUP>Y</GROUP>"
                End If
                If Not (IsEmpty(ColSet) Or Trim(ColSet) = "") Then
                    Print #1, Chr(9) + Chr(9) + Chr(9) + "<SET>Y</SET>"
                End If
            End If
        End If
        Print #1, Chr(9) + Chr(9) + "</COLUMN>"
    End If
Next i
 
'ファイルを閉じる
Print #1, Chr(9) + "</COLUMNS>"
Print #1, "</IFDEF>"
Close #1

'If RecCnt <> nowCnt - 1 Then
'    MsgBox "ちゃんと出来ませんでした、順位がおかしい、通番か確認しなさい。"
'Else
    MakeCreateIF = 0
'End If

End Function

'SQLの作成
Function MakeCreateIFPlus(FilePath, SQLSheetName, DeleteFlag) As Integer

MakeCreateIFPlus = -1

End Function
Function SetPrimaryKey() As String
'テーブル定義Sheetからキー定義部分を探す(仮)
For i = SQLCreateRow To 65535
  If Cells(i, ItemIDCol) <> "" Then
    vala = VBA.UCase(Cells(i, ItemPKeyCol))
    If vala <> "" Then
        SetPrimaryKey = SetPrimaryKey & Cells(i, ItemIDCol) & ","
    End If
  Else
    i = 9999999 'スペースカラムで終了とする
  End If
Next i
    SetPrimaryKey = Left(SetPrimaryKey, Len(SetPrimaryKey) - 1)
End Function
Function FindCell(idx, pry As Integer) As String
'テーブル定義Sheetからキー定義部分を探す
   
    FindCell = ""
    pry = 0
    Select Case idx
      Case Is < 10
        s1 = Right(Str(idx), Len(Str(idx)) - 1)
      Case 10
        s1 = "A"
      Case 11
        s1 = "B"
      Case 12
        s1 = "C"
      Case 13
        s1 = "D"
      Case 14
        s1 = "E"
      Case 15
        s1 = "F"
      Case 16
        s1 = "G"
      Case 17
        s1 = "H"
      Case 18
        s1 = "I"
      Case 19
        s1 = "J"
      Case 20
        s1 = "K"
      Case 21
        s1 = "L"
      Case 22
        s1 = "M"
      Case 23
        s1 = "N"
      Case 24
        s1 = "O"
      Case 25
        s1 = "P"
      Case 26
        s1 = "Q"
      Case 27
        s1 = "R"
      Case 28
        s1 = "S"
      Case 29
        s1 = "T"
      Case 30
        s1 = "U"
    End Select
   
    For i = 0 To 30
        colname = Cells(SQLCreateRow, ItemIDCol)
        s2 = "[" + s1
        s3 = "<" + s1
        s4 = "{" + s1
        j = 0
        While colname <> ""
            vala = VBA.UCase(Cells(SQLCreateRow + j, ItemPKeyCol))
            rcd2 = InStr(1, vala, s2)
            rcd3 = InStr(1, vala, s3)
            rcd4 = InStr(1, vala, s4)
            If Not (rcd2 = 0 And rcd3 = 0 And rcd4 = 0) Then
                If (rcd2 <> 0) Then
                    rcd2 = rcd2 + 2
                    rcd = InStr(rcd2, vala, "]")
                    rcd = Val(Mid(vala, rcd2, rcd - rcd2))
                    rcd1 = 1
                End If
                If (rcd3 <> 0) Then
                    rcd3 = rcd3 + 2
                    rcd = InStr(rcd3, vala, ">")
                    rcd = Val(Mid(vala, rcd3, rcd - rcd3))
                    rcd1 = 2
                End If
                If (rcd4 <> 0) Then
                    rcd4 = rcd4 + 2
                    rcd = InStr(rcd4, vala, "}")
                    rcd = Val(Mid(vala, rcd4, rcd - rcd4))
                    rcd1 = 3
                End If
                If (rcd = i) Then
                    If rcd1 = 2 Then
                        colname = colname & " DESC"
                    End If
                    If rcd1 = 3 Then
                        pry = 1
                    End If
                    If FindCell = "" Then
                        FindCell = colname
                    Else
                        FindCell = FindCell + ", " + colname
                    End If
                    GoTo FindCell_exit1
                End If
            End If
            j = j + 1
            colname = Cells(SQLCreateRow + j, ItemIDCol)
        Wend
        GoTo FindCell_exit2
FindCell_exit1:
    Next i
FindCell_exit2:
End Function

'バッチファイルを実行します
Public Sub ExecCommand(sCommand As String)
    ' 変数宣言部
    Dim oShell As Object, oExec As Object

    ' オブジェクト変数に参照をセットします。
    Set oShell = CreateObject("WScript.Shell")
    oShell.Run sCommand, 0, True

End Sub

'シート検索
Sub SheetNamesLineUpIF()

Dim mstrDirStack() As String
Dim lngDirNum() As Long
Dim lngDirPointer() As Long
Dim strDirName As String
Dim strDirReturn As String

lngDirCnt1 = 0
lngDirCnt2 = 0
lngDirCnt3 = 0
blnDirExistFlag = False
strFolderName = Cells(InPathRow, 2)

Worksheets("ホストIF").Range("A14:B2000").Clear

ReDim Preserve mstrDirStack(lngDirCnt1)
mstrDirStack(lngDirCnt1) = strFolderName
lngDirCnt1 = lngDirCnt1 + 1
ReDim Preserve lngDirNum(lngDirCnt2)
lngDirNum(lngDirCnt2) = lngDirCnt1
lngDirCnt2 = lngDirCnt2 + 1
ReDim Preserve lngDirPointer(lngDirCnt3)
lngDirPointer(lngDirCnt3) = lngDirCnt1
lngDirCnt3 = lngDirCnt3 + 1

i = 0
strDirName = strFolderName & "\"
strDirReturn = Dir(strDirName, vbDirectory)
Do While strDirReturn <> ""
  If strDirReturn <> "." And strDirReturn <> ".." Then
    If (GetAttr(strDirName & strDirReturn) And vbDirectory) = vbDirectory Then
      blnDirExistFlag = True
      ReDim Preserve mstrDirStack(lngDirCnt1)
      mstrDirStack(lngDirCnt1) = strDirName & strDirReturn
      lngDirCnt1 = lngDirCnt1 + 1
    Else
        If (BookCheck3(strDirName, strDirReturn, SheetNameStartRow + i) = 0) Then
            Cells(SheetNameStartRow + i, SheetNameStartCol) = strDirName + strDirReturn
            i = i + 1
        End If
    End If
  End If
  strDirReturn = Dir
Loop

If blnDirExistFlag = True Then
  ReDim Preserve lngDirNum(lngDirCnt2)
  lngDirNum(lngDirCnt2) = lngDirCnt1
  lngDirCnt2 = lngDirCnt2 + 1
  ReDim Preserve lngDirPointer(lngDirCnt3)
  lngDirPointer(lngDirCnt3) = lngDirCnt1
  lngDirCnt3 = lngDirCnt3 + 1
Else
  Exit Sub
End If

Do
  blnDirExistFlag = False
  If lngDirCnt3 = 1 Then
    lngDirStart = 0
  Else
    lngDirStart = lngDirPointer(lngDirCnt3 - 2)
  End If

  For lngFor_Cnt = lngDirStart To lngDirPointer(lngDirCnt3 - 1) - 1
    strDirName = mstrDirStack(lngFor_Cnt) & "\"
    strDirReturn = Dir(strDirName, vbDirectory)
    Do While strDirReturn <> ""
      If strDirReturn <> "." And strDirReturn <> ".." Then
        If (GetAttr(strDirName & strDirReturn) And vbDirectory) = vbDirectory Then
          blnDirExistFlag = True
          ReDim Preserve mstrDirStack(lngDirCnt1)
          mstrDirStack(lngDirCnt1) = strDirName & strDirReturn
          lngDirCnt1 = lngDirCnt1 + 1
        Else
          If (BookCheck3(strDirName, strDirReturn, SheetNameStartRow + i) = 0) Then
            Cells(SheetNameStartRow + i, SheetNameStartCol) = strDirName + strDirReturn
            i = i + 1
          End If
        End If
      End If
      strDirReturn = Dir
    Loop

    If lngDirCnt1 <> 0 Then
      ReDim Preserve lngDirNum(lngDirCnt2)
      lngDirNum(lngDirCnt2) = lngDirCnt1
        lngDirCnt2 = lngDirCnt2 + 1
    End If
  Next lngFor_Cnt

  If blnDirExistFlag = True Then
    ReDim Preserve lngDirPointer(lngDirCnt3)
    lngDirPointer(lngDirCnt3) = lngDirCnt1
    lngDirCnt3 = lngDirCnt3 + 1
  End If
Loop While blnDirExistFlag = True

End Sub