excel每天自动上传mysql_上传EXCEL表格至SQL数据库(自动建表)

Public Sub AutoTable()

Dim conExcel As New Connection, conSQL As New Connection, rs As New Recordset, fieldDef As String, fieldStr As String, rsValue As String, fileName As String, tabName As String

fileName = Application.GetOpenFilename("Excel files,*.xlsx;*.xls;*.csv", , "Select file")

If fileName = "" Or fileName = "False" Then Exit Sub

conSQL.Open B2CConnString

Set wb = Workbooks.Open(fileName, False)

conExcel.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" + fileName

For Each ws In wb.Sheets

tabName = Replace(Replace(Replace(Left(wb.Name, InStr(1, wb.Name, ".") - 1), " ", "_"), "(", "_"), ")", "_") + "_" + Replace(ws.Name, " ", "_")

fieldDef = "ID int identity(1,1) not null"

fieldStr = ""

rs.Open "SELECT * FROM [" + ws.Name + "$]", conExcel, 1, 1

rs.MoveFirst

For i = 0 To rs.Fields.Count - 1

fieldDef = fieldDef + "," + Replace(rs.Fields(i).Name, " ", "_") + " nvarchar(800) null"

fieldStr = IIf(fieldStr = "", "", fieldStr + ",") + Replace(rs.Fields(i).Name, " ", "_")

Next

conSQL.Execute "IF OBJECT_ID('" + tabName + "') IS NOT NULL DROP TABLE " + tabName + " CREATE TABLE " + tabName + "(" + fieldDef + ")"

Do While Not rs.EOF

rsValue = ""

For i = 0 To rs.Fields.Count - 1

rsValue = IIf(rsValue = "", "", rsValue + ",") + "'" + Replace(Nz(rs(i), ""), "'", "''") + "'"

Next

conSQL.Execute "INSERT INTO " + tabName + "(" + fieldStr + ") VALUES (" + rsValue + ")"

rs.MoveNext

Loop

rs.Close

Next

wb.Close False

Set wb = Nothing

Set ws = Nothing

End Sub