一个自动生成db2SQL的宏！【分享给大家】
由于以前没有用过VB，这两天花了点时间学习了一下VB，然后写一个用Excel自动生成db2SQL的宏！这样生成后建就方便多了。程序可能有好多Bug，请多多指教。
下面是表格中的数据：
ACGDM-股东移植表
序号字段英文名字段中文名数据类型键值空值备注
1GDBRNO 联社号 CHAR(2) yNOT NULL
2GDSBNO 网点号 CHAR(3)
3GDCUNM 股东姓名CHAR(10)
4GDSEXX 股东性别CHAR(1) NOT NULL
5GDADDR 股东地址CHAR(42)
AEADA-代收电费地区对照表
序号字段英文名字段中文名数据类型键值空值备注
1ADLETT 地区字母代码CHAR(2)
2ADNUMB 地区数字代码CHAR(2) NOT NULL
3ADSTCD 记录状态CHAR(1)
AEDTA-代收明细表
序号字段英文名字段中文名数据类型键值空值备注
1DTCUNO 户号 CHAR(10)NOT NULL
2DTYEAR 年 CHAR(4) yNOT NULL
3DTMONT 月 CHAR(2)
注：在excel表格中，每一行为空行，上面三个表的表与表之间的有一个空行。
下面是写在宏中的程序：
Private Sub test1()
Dim fsA, fA, tsA
'##################################
'
' 功能：自动生成SQL建表语句
' author:XXX
' date:20101021
'
'##################################
Dim iFirstRow As Long
iFirstRow = 1
'##################################
Dim iEndRow As Long
iEndRow = 20 '末行行数，要准确填上
'##################################
Dim mode As String
mode = "SDM" + "." + "S01" + "_" '表的模式名
'第一个文件
Set fsA = CreateObject("Scripting.FileSystemObject")
fsA.CreateTextFile "D:\VB\" + "CreateSDM" + ".sql"
Set fA = fsA.GetFile("D:\VB\" + "CreateSDM" + ".sql")
Set tsA = fA.OpenAsTextStream(2)
'第二个文件
Set fsB = CreateObject("Scripting.FileSystemObject")
fsB.CreateTextFile "D:\VB\temp\" + "CreateSDM" + ".sql"
Set fB = fsB.GetFile("D:\VB\temp\" + "CreateSDM" + ".sql")
Set tsB = fB.OpenAsTextStream(2)
'第三个文件
Set fsC = CreateObject("Scripting.FileSystemObject")
fsC.CreateTextFile "D:\VB\temp\" + "PK" + ".sql"
Set fC = fsC.GetFile("D:\VB\temp\" + "PK" + ".sql")
Set tsC = fC.OpenAsTextStream(2)
While iFirstRow <= iEndRow
Dim table As String
Dim strLen As Long
Dim subCol As Long
Dim tableName As String '表名
Dim tableNameDemo As String '表中文名
Dim fieldName As String '字段名
Dim fieldNameDemo As String '字段中文名
Dim fieldType As String '字段类型
Dim fieldNull As String '字段空值
Dim fieldPK As String '主键
Dim checkNo1 As String
checkNo1 = Trim(ActiveSheet.Cells(iFirstRow + 1, 1).Value) '判断是否是序号
If checkNo1 = "序号" Then
iFirstRow = iFirstRow + 1
Else
If ActiveSheet.Cells(iFirstRow, 1).Value = "" Then
table = Trim(ActiveSheet.Cells(iFirstRow + 1, 1).Value)
strLen = Len(table)
subCol = InStr(table, "-")
tableName = Mid(table, 1, subCol - 1)
tableNameDemo = Mid(table, subCol + 1, strLen)
tsA.writeline ""
tsA.writeline ""
tsA.writeline "DROP TABLE " + mode + tableName + ";"
tsA.writeline "--------------------------------------------------"
tsA.writeline "-- Create Table " + mode + tableName
tsA.writeline "--------------------------------------------------"
tsA.writeline ""
tsA.writeline "Create table " + mode + tableName
tsA.writeline "("
Else '不为空时
Dim strtmp As String
strtmp = ""
fieldName = ActiveSheet.Cells(iFirstRow, 2).Value
fieldNameDemo = ActiveSheet.Cells(iFirstRow, 3).Value
fieldType = ActiveSheet.Cells(iFirstRow, 4).Value
fieldNull = ActiveSheet.Cells(iFirstRow, 6).Value
If ActiveSheet.Cells(iFirstRow + 1, 1).Value = "" Then '如果iFirstRow + 1为空时
Dim strtmp2 As String
strtmp2 = "in DTS_DATA Index in DTS_IDX ;" '表空间和表索引空间
strtmp = strtmp + ") " + strtmp2
tsA.writeline " " + fieldName + " " + fieldType + " " + fieldNull
tsB.writeline "Comment on Column " + mode + tableName + "." + fieldName + " is '" + fieldNameDemo + "';"
tsA.writeline strtmp
tsA.writeline ""
tsA.writeline "Comment on Table " + mode + tableName + " is '" + tableNameDemo + "';"
Open "D:\VB\temp\CreateSDM.sql" For Binary As #1
commentTTT = StrConv(InputB(LOF(1), 1), vbUnicode)
tsA.writeline commentTTT
Close #1
tsB.Close
Dir ("D:\VB\temp\" + "CreateSDM" + ".sql")
Kill ("D:\VB\temp\" + "CreateSDM" + ".sql")
Set fsB = CreateObject("Scripting.FileSystemObject")
fsB.CreateTextFile "D:\VB\temp\" + "CreateSDM" + ".sql"
Set fB = fsB.GetFile("D:\VB\temp\" + "CreateSDM" + ".sql")
Set tsB = fB.OpenAsTextStream(2)
'此时iFirstRow值为某表的最末一行
If Trim(ActiveSheet.Cells(iFirstRow, 5).Value) = "Y" Or Trim(ActiveSheet.Cells(iFirstRow, 5).Value) = "y" Then
fieldPK = ActiveSheet.Cells(iFirstRow, 2)
tsC.writeline fieldPK
End If
Dim strTT As String '读temp/PK.sql文件变量
Dim checkPK As String '用来判断primary key 是否存在
Dim checkPKTT As Boolean '用来判断primary key 是否存在，True为存在，False为不存在
Open "D:\VB\temp\PK.sql" For Input As #1
checkPK = InputB(LOF(1), 1)
If checkPK <> "" Then
checkPKTT = True
Else
checkPKTT = False
End If
Close #1
If checkPKTT = True Then
tsA.writeline "--------------------------------------------------"
tsA.writeline "-- Create primary key PK_" + tableName + "TTT"
tsA.writeline "--------------------------------------------------"
tsA.writeline ""
tsA.writeline "Alter table " + mode + tableName + " add constraint " + "PK_" + tableName + "TTT primary key ("
Open "D:\VB\temp\PK.sql" For Input As #1
Do Until EOF(1)
Line Input #1, strTT
If EOF(1) = True Then
tsA.writeline " " + strTT + " ) ;"
Else
tsA.writeline " " + strTT + ","
End If
Loop
Close #1
End If
tsC.Close
Set tsC = Nothing
Set fC = Nothing
Set fsC = Nothing
Dir ("D:\VB\temp\" + "PK" + ".sql")
Kill ("D:\VB\temp\" + "PK" + ".sql")
tsA.writeline ""
'第三个文件
Set fsC = CreateObject("Scripting.FileSystemObject")
fsC.CreateTextFile "D:\VB\temp\" + "PK" + ".sql"
Set fC = fsC.GetFile("D:\VB\temp\" + "PK" + ".sql")
Set tsC = fC.OpenAsTextStream(2)
Else
If Trim(ActiveSheet.Cells(iFirstRow, 1).Value) <> "序号" Then
strtmp = strtmp + ","
tsA.writeline " " + fieldName + " " + fieldType + " " + fieldNull + strtmp
tsB.writeline "Comment on Column " + mode + tableName + "." + fieldName + " is '" + fieldNameDemo + "';"
End If
If Trim(ActiveSheet.Cells(iFirstRow, 5).Value) = "Y" Or Trim(ActiveSheet.Cells(iFirstRow, 5).Value) = "y" Then
fieldPK = ActiveSheet.Cells(iFirstRow, 2)
tsC.writeline fieldPK
End If
End If
End If
End If
iFirstRow = iFirstRow + 1
Wend
tsA.Close
Set tsA = Nothing
Set fA = Nothing
Set fsA = Nothing
tsB.Close
Set tsB = Nothing
Set fB = Nothing
Set fsB = Nothing
Kill ("D:\VB\temp\" + "CreateSDM" + ".sql")
tsC.Close
Set tsC = Nothing
Set fC = Nothing
Set fsC = Nothing
Kill ("D:\VB\temp\" + "PK" + ".sql")
End Sub
