打开APP
userphoto
未登录

开通VIP,畅享免费电子书等14项超值服

开通VIP
数据字典到SQL语句的转换(使用word与VBA)

一般我们有几种方式对数据库建模:

1.采用PowerDesign或ErWin等建模工具进行建模

2.利用WORD或EXCEL进行建模

使用第一种方式,可以自动导出要生产表的SQL语句,建表比较方便,而对于第二种方式,则可能需要手工建表,其实在WORD中可以用VBA完成对SQL语句的生成,如将下面格式的WORD数据字典生成SQL语句,就可以利用VBA进行

WORD文档样式为:

Table1

PK

 默认值

Field1

Varchar(50)

 1

Field2

Int

Field3

Int

Field4

Numeric(18,4)

Function GetCreateStr()
Dim docOld As Document
Dim rngDoc As Range
Dim tblDoc As Table
Dim i As Integer, iIndex1 As Integer, iIndex2 As Integer
Dim myCell As Cell
Dim sTemp As String, sTemp1 As String, sTemp2 As String
Dim sHead As String
Dim sResult As String, sLength As String
Dim sDou As String, s1 As String
Dim sDou1 As String, sKey As String
Dim sTableName As String

sDou = '''': sDou1 = '''
If ActiveDocument.Tables.Count >= 1 Then
For i = 1 To ActiveDocument.Tables.Count
sTableName = ActiveDocument.Tables(i).Cell(1, 2).Range.Text
sTableName = Mid(sTableName, 1, Len(sTableName) - 2)
s1 = 'USE [SocialKey]' & vbCrLf & vbCrLf & 'GO ' & vbCrLf & vbCrLf & _
'/****** 对象: Table [dbo].[' & sTableName & '] 脚本日期: ' & Now & _
'******/' & vbCrLf & vbCrLf & _
'SET ANSI_NULLS ON ' & vbCrLf & vbCrLf & _
'SET QUOTED_IDENTIFIER ON ' & vbCrLf & _
'GO ' & vbCrLf

sHead = s1 & vbctrl & 'if exists (select * from dbo.sysobjects where id = object_id(N' & sDou1 & _
'[dbo].[' & sTableName & ']' & sDou1 & ') and OBJECTPROPERTY(id, N' & sDou1 & _
'IsUserTable' & sDou1 & ') = 1)' & vbCrLf & _
vbTab & ' drop table [dbo].[' & sTableName & ']' & vbCrLf & _
'GO' & vbCrLf & _
'CREATE TABLE [dbo].[' & sTableName & '] ('

sTemp = '': sResult = ''

For j = 3 To ActiveDocument.Tables(i).Rows.Count
Set myCell = ActiveDocument.Tables(i).Cell(j, 1)
sTemp = Mid(myCell.Range.Text, 1, Len(myCell.Range.Text) - 2)
If Trim(sTemp) <> '' Then
sTemp = vbTab & '[' & sTemp & ']'

Set myCell = ActiveDocument.Tables(i).Cell(j, 3)
sTemp1 = Mid(myCell.Range.Text, 1, Len(myCell.Range.Text) - 2)
iIndex1 = InStr(sTemp1, '(')
If iIndex1 > 0 Then
iIndex2 = InStr(sTemp1, ')')
sLength = Mid(sTemp1, iIndex1 + 1, iIndex2 - iIndex1 - 1)
sTemp1 = Mid(sTemp1, 1, iIndex1 - 1)
sTemp2 = '[' & sTemp1 & ']' & ' (' & sLength & ')' & ' NULL' & ','

Else
sTemp2 = '[' & sTemp1 & ']' & ' NULL' & ','
End If
sResult = sResult & sTemp & ' ' & sTemp2 & vbCrLf
End If
Next j
sResult = sHead & vbCrLf & sResult
Next i
End If
sResult = Mid(sResult, 1, Len(sResult) - 3) & vbCrLf & ')'
GetCreateStr = sResult
'Debug.Print GetCreateStr
End Function


Sub StrToFile(sContent As String, sFile As String)
Kill sFile '首先删除源文件
Open sFile For Append As #1 '打开文件
Print #1, sContent '写入文件
Close #1
End Sub



Private Sub CommandButton2_Click()
Dim sTemp As String, sPath As String
sTemp = GetCreateStr
'Debug.Print sTemp
sPath = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4)
'Debug.Print ActiveDocument.Path & sPath & '.txt'
Call StrToFile(sTemp, ActiveDocument.Path & '\' & sPath & '.txt')
End Sub
本站仅提供存储服务,所有内容均由用户发布,如发现有害或侵权内容,请点击举报
打开APP,阅读全文并永久保存 查看更多类似文章
猜你喜欢
类似文章
【热】打开小程序,算一算2024你的财运
108.取得一个短文件名的长文件名
VBA 操作word(转载收藏)
Excel 逻辑运算符按位运算
学习VBA
VB6.0对TXT文本文件的读写删操作
查找关键字单元格
更多类似文章 >>
生活服务
热点新闻
分享 收藏 导长图 关注 下载文章
绑定账号成功
后续可登录账号畅享VIP特权!
如果VIP功能使用有故障,
可点击这里联系客服!

联系客服