VBA操作word生成sql语句

项目开始一般都是用word保存下数据库的文档

但是从表单一个一个的建表实在是很困难乏味，查查资料

1、可以生成一个html或者xml，检索结构生成sql。但是这个方式也蛮麻烦

2、查到vba可以操作word读取表格。所以采用这种方式写了一个小程序。这样就可以直接生成sql了，在这里做个记录。

代码很初级，意见欢迎，勿喷。

 

Public Sub test()
 'Word对象定义
    Dim objWord As New Word.Application
    Dim objWordNew As New Word.Application
    
    'Doc对象定义
    Dim objDoc As Word.Document
    Dim objDocNew As Word.Document
    
    '读取指定文件至Doc对象
    Set objDoc = objWord.Documents.Open("D:\新建 Microsoft Word 文档.docx")
    Set objDocNew = objWordNew.Documents.Open("D:\sql.docx")
    

     'Table对象定义
    Dim objTable As Word.Table
    Dim tempStr
    tempStr = ""
    
    '读取指定文件中的表1至Table对象
    'Set objTable = objDoc.Tables(2)
    For a = 1 To objDoc.Tables.Count
        Set objTable = objDoc.Tables(a)
        tempStr = tempStr + "CREATE TABLE ("
        tempStr = tempStr + Chr(10)
        For i = 2 To objTable.Rows.Count
                
                'tempStr = tempStr + "'" + Application.WorksheetFunction.Clean(objTable.Cell(i, 2).Range.Text) + "' " + objTable.Cell(i, 4).Range.Text + " COMMENT '" + objTable.Cell(i, 2).Range.Text + objTable.Cell(i, 6).Range.Text + "'"
                tempStr = tempStr + "'" + Replace(Replace(objTable.Cell(i, 2).Range.Text, Chr(10), ""), Chr(13), "") + "' " + Replace(Replace(objTable.Cell(i, 4).Range.Text, Chr(10), ""), Chr(13), "") + " COMMENT '" + Replace(Replace(objTable.Cell(i, 3).Range.Text, Chr(10), ""), Chr(13), "") + Replace(Replace(objTable.Cell(i, 6).Range.Text, Chr(10), ""), Chr(13), "") + "'"
                
                'tempStr = Replace(tempStr, Chr(10), "")
                'tempStr = Replace(tempStr, Chr(13), "")
                tempStr = tempStr + Chr(10)
        Next
        tempStr = tempStr + ")ENGINE=MyISAM DEFAULT CHARSET=utf8;"
        tempStr = tempStr + Chr(10)
        tempStr = tempStr + Chr(10)
    Next
    
    objDocNew.Range.Text = tempStr
    '关闭Doc对象
    objDoc.Close
    objDocNew.Close
    
    '关闭Word对象
    objWord.Quit
    objWordNew.Quit
    
    
    '清除Table对象
    Set objTable = Nothing
    '清除Doc对象
    Set objDoc = Nothing
    '清除Word对象
    Set objWord = Nothing
End Sub

中间有一些替换回车换行符的，也有添加的，为了生成理想的格式，拼接字符串。