|
|
楼主 |
发表于 2023-1-5 05:26
|
显示全部楼层
批量导入xls数据到sql数据库，我写成功没有问题，就是运行比较慢。问题是这个写法只支持XLS/XLSX格式的，不支持CSV格式的，或者哪个高手根据这个改成可以支持CSV格式的也行。注：csv文件大的有百万行，且有200个左右。
Sub 批量导入xls文件到sql()
#If ProjectStatus = "DEV" Then
Dim cn As ADODB.Connection
#Else ' assume PROD
Dim cn As Object
Set cn = CreateObject("ADODB.Connection")
#End If
Const dizhi As String = "D:\数据\" '这个路径名最后一定要有一个反斜杠 "\"
Const geshiC As String = ".csv"
Const geshiX As String = ".xlsx" '（如果是2007版，则后缀名请改为 *.xlsx）
Dim strSQL As String
Dim lngRecsAff As Long
Dim Headers As Boolean
Dim strConn As String
Dim path As String, fnTemp As String
Dim start As Double
start = Timer() '计算这个程序运行时间。
On Error GoTo test_Error
Dim fn, fp
'关闭屏幕刷新
Application.ScreenUpdating = False
fp = dizhi
fn = Dir(fp & "*" & geshiX) '取得第一个工作簿的文件名
Do While fn <> ""
Headers = True
path = fp & fn
fnTemp = Replace(fn, geshiX, "")
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & path & ";" & "Extended Properties=""Excel 8.0; IMEX=1;HDR=YES""" '这条语句支持xls/xlsx格式文件，不支持CSV格式
Debug.Print strConn
cn.Open strConn
strSQL = "Insert INTO [odbc;Driver={SQL Server};" & _
"Server=.;Database=数据库名;" & _
"UID=用户名;PWD=密码].表名 Select 字段一,字段二,字段三,字段四,字段五,字段六 FROM [" & fnTemp & "$] "
Debug.Print strSQL
cn.Execute strSQL, lngRecsAff
Debug.Print "Records affected: " & lngRecsAff
fn = Dir() '取得下一个工作簿的文件名
cn.Close
Loop '循环
Set cn = Nothing
'打开屏幕刷新
Application.ScreenUpdating = True
fenzhong = Int(Format(Timer - start, "0.00") / 60)
MsgBox "程序运行时间约是 " & fenzhong & " 分钟."
On Error GoTo 0
Exit Sub
test_Error:
MsgBox "strSQL＝" & strSQL & Chr(10) & " Error " & Err.Number & " (" & Err.Description & ") in procedure test of VBA Document ThisWorkbook"
End Sub |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2023-1-5 04:51
