Sub 将活动表格标题生成sqlserver建表语句()
'需要确保在VBA编辑器中已引用"Microsoft Forms 2.0 Object Library"（通常在引用列表中显示为"FM20.dll"）
Dim strText As String, colTypes As String, values As String
'首先生成create表语句,默认首行为标题
arr = Range("a1").CurrentRegion
TableName = InputBox("请输入Oracle表名:", "表名输入", "YOUR_TABLE_NAME")
'If Not TableName Like "[a-zA-Z]*" Then MsgBox "表名不是以字母开头,请从新开始": Exit Sub
For i = 1 To UBound(arr, 2)
If Len(Trim(arr(1, i))) = 0 Then MsgBox "第一行有空单元格": Exit Sub
Next i
For i = 1 To UBound(arr, 2)
colnames = colnames & arr(1, i)
If i < UBound(arr, 2) Then colnames = colnames & ","
colTypes = colTypes & arr(1, i) & " varchar(800)," & Chr(13)
Next i
colTypes = Left(colTypes, InStrRev(colTypes, ",") - 1) & Mid(colTypes, InStrRev(colTypes, ",") + 1)
'以上为生产建表语句
strText = "CREATE TABLE " & "[dbo].[" & TableName & _
"](" & Chr(13) & colTypes & ") ON [PRIMARY]"
' 将文本放入剪贴板
With New DataObject
.SetText strText
.PutInClipboard
End With
MsgBox "生成的sql语句已复制到粘贴板！"
End Sub 作者: sjp060305 时间: 2025-8-28 11:25
虽然不知道LZ在说什么但是感觉很厉害的样子～作者: aduge38 时间: 2025-8-28 11:37
不明觉厉啊，谢谢分享作者: likeyouli 时间: 2025-8-28 14:52
"'"&A2&"',"&"'"&B2&"',"&"'"&C2&"',"&"'"&D2&"',"&"'"&E2&"',"&"'"&F2&"',"&"'"&G2&"',"&"'"&H2&"',"&"'"&I2&"',"&"'"&J2&"',"&"'"&K2&"',"&"'"&L2&"',"&"'"&M2&"',"&"'"&N2&"',"&"'"&O2&"',"&"'"&P2&"',"&"'"&Q2&"',"&"'"&R2&"',"&"'"&S2&"',"&"'"&T2&"',"&"'"&U2&"',"&"'"&V2&"',"&"'"&W2&"',"&"'"&X2&"',"&"'"&Y2&"',"&" '"&Z2&"'" ----------------------------------------------------------------------
"INSERT INTO nihao VALUES("&AA2&");"
https://docs.oracle.com/error-help/db/ora-00933/00933. 00000 - "unexpected keyword at or near %s"
*Cause: An unexpected keyword was encountered in the SQL statement at
or near the position printed in the error message.
One of the following occurred:
1. You had a typo in your SQL statement.
2. Unsupported syntax was encountered for a clause in the
statement.
3. An unsupported clause was encountered in the statement.
4. A string was terminated prematurely leading to the rest
of the string to be interpreted as keywords. For example, an
apostrophe in the string may be causing it to
end prematurely.
*Action: Take the action that corresponds with the Cause
1. Check that your SQL statement has no typos.
2. Check Oracle Database documentation to find the
correct syntax for the clause and update the problematic
clause appropriately.
3. Check Oracle Database documentation to find the correct
syntax for the statement and remove the unsupported clause.
4. Enter two single quotes instead of one to represent an
apostrophe within a string.
*Params: 1) keyword_value
keyword near the keyword causing the error. The keyword value
may be truncated for readability if it is too long.
这个错误 ORA-00933: SQL 命令未正确结束 的原因是：Oracle 数据库不支持在一条 INSERT 语句中使用多个 VALUES 子句进行多行插入。
直接生成sql文件，且为utf-8编码，速度比用数组快多了，生成后又用vba调用powershell每隔500行插入一行“commit” ，实在费死劲了。最后插入commit的时候可能提示什么错误，但不影响导入。
Sub 生成sql文件且为utf-8编码()
Dim i
filepath1 = "C:\shengcheng.sql"
TableName = InputBox("请输入Oracle表名:", "表名输入", "YOUR_TABLE_NAME")
If Not TableName Like "[a-zA-Z]*" Then MsgBox "表名不是以字母开头,请从新开始": Exit Sub
'因为后边用公式生成的insert into语句最多只能到26个字母，再多只能手动。
For i = 1 To 26
If Cells(1, i + 1) = "" Then colTypes = colTypes & Cells(1, i) & " varchar2(800)": Exit For
colTypes = colTypes & Cells(1, i) & " varchar2(800)," & vbCrLf
Next i
strText = "set echo on;" & vbCrLf & "CREATE TABLE " & TableName & vbCrLf & "(" & colTypes & ");" & vbCrLf & "commit;" & vbCrLf
'With New DataObject
' .SetText strText
' .PutInClipboard
' End With
'psCommand = "powershell -Command ""Get-Clipboard -TextFormatType UnicodeText | Out-File -Encoding UTF8 '" & filepath1 & "'"""
'Shell psCommand, vbHide
'Application.Wait Now + TimeValue("00:00:03")
Dim oShell As Object, psCommand As String
Set oShell = CreateObject("WScript.Shell")
psCommand = "powershell -Command " & _
"""$bytes = [System.Text.Encoding]::UTF8.GetBytes('" & strText & "'); " & _
"$stream = [System.IO.File]::Create('" & filepath1 & "'); " & "$stream.Write($bytes, 0, $bytes.Length); " & "$stream.Close()"""
oShell.Run psCommand, 1, True
Set oShell = Nothing
letters = "abcdefghijklmnopqrstuvwxyz"
For i = 1 To 26
If Cells(1, i + 1) = "" Then xx = xx & """'""" & "&" & Mid(letters, i, 1) & 2 & "&" & """');""": Exit For
If i = 1 Then
xx = xx & """INSERT INTO """ & " &" & """" & TableName & """" & "&" & """ VALUES(""" & "&" & """'""" & "&" & Mid(letters, i, 1) & 2 & "&" & """'""" & "&" & """,""" & "&" '生成的单元格内容被双引号包裹，费劲千辛万苦测试出来
Else
xx = xx & """'""" & "&" & Mid(letters, i, 1) & 2 & "&" & """'""" & "&" & """,""" & "&"
End If
Next i
Cells(2, i + 1) = "=" & xx
h = 10
'h = Range("a1").CurrentRegion.Rows.Count
Cells(2, i + 1).AutoFill Range(Cells(2, i + 1), Cells(h, i + 1))
Range(Cells(2, i + 1), Cells(h, i + 1)).Copy
