用dts吧给你个例子:Private Function ImportFileToTempTable_DTS(strPath As String) As Boolean
Dim oConnection As DTS.Connection
Dim oStep As DTS.Step
Dim oTask As DTS.Task
Dim oCustomTask As DTS.BulkInsertTask 'TaskObject
On Error GoTo PackageError ImportFileToTempTable_DTS = True
Screen.MousePointer = vbHourglass
'Create connections, step, tasks
prgStatus.Value = 10
Set oConnection = oPackage.Connections.New("SQLOLEDB")
Set oStep = oPackage.Steps.New
Set oTask = oPackage.Tasks.New("DTSBulkInsertTask")
Set oCustomTask = oTask.CustomTask
'Set up and database connections
SetConnections oPackage, oConnection
With oStep
.name = "GenericPkgStep"
.ExecuteInMainThread = True
End With
'Customize the Task Object
With oCustomTask
.name = "GenericPkgTask"
.DataFile = strPath
.ConnectionID = 1
.DestinationTableName = strDBName & "..surrey_vip_import_temp"
.FieldTerminator = VBA.Chr(9)
.RowTerminator = vbCrLf '"\n\r"
End With
oStep.TaskName = oCustomTask.name
'Add the step
With oPackage
.Steps.Add oStep
.Tasks.Add oTask
.FailOnError = True
End With
'Run the package and release references.
prgStatus.Value = 40
oPackage.Execute
prgStatus.Value = prgStatus.Max
'Clean up
Set oConnection = Nothing
Set oCustomTask = Nothing
Set oTask = Nothing
Set oStep = Nothing
oPackage.UnInitialize
Screen.MousePointer = vbDefaultExit FunctionPackageError:
Dim sMsg As String
sMsg = "Package failed error: " & sErrorNumConv(Err.Number) & _
vbCrLf & Err.Description & vbCrLf & sAccumStepErrors(oPackage)
MsgBox sMsg, vbExclamation, oPackage.name
Set oConnection = Nothing
Set oCustomTask = Nothing
Set oTask = Nothing
Set oStep = Nothing
oPackage.UnInitialize
Screen.MousePointer = vbDefault
prgStatus.Value = 0
ImportFileToTempTable_DTS = False
End FunctionPrivate Function sAccumStepErrors(ByVal oPackage As DTS.Package) As String
Dim oStep As DTS.Step
Dim sMessage As String
Dim lErrNum As Long
Dim sDescr As String
Dim sSource As String 'Look for steps that completed and failed.
For Each oStep In oPackage.Steps
If oStep.ExecutionStatus = DTSStepExecStat_Completed Then
If oStep.ExecutionResult = DTSStepExecResult_Failure Then
'Get the step error information and append it to the message.
oStep.GetExecutionErrorInfo lErrNum, sSource, sDescr
sMessage = sMessage & vbCrLf & _
"Step " & oStep.name & " failed, error: " & _
sErrorNumConv(lErrNum) & vbCrLf & sDescr & vbCrLf
End If
End If
NextsAccumStepErrors = sMessage
End Function
Private Function sErrorNumConv(ByVal lErrNum As Long) As String
If lErrNum < 65536 And lErrNum > -65536 Then
sErrorNumConv = "x" & Hex(lErrNum) & ", " & CStr(lErrNum)
Else
sErrorNumConv = "x" & Hex(lErrNum) & ", x" & _
Hex(lErrNum And -65536) & " + " & CStr(lErrNum And 65535)
End If
End Function
Dim oConnection As DTS.Connection
Dim oStep As DTS.Step
Dim oTask As DTS.Task
Dim oCustomTask As DTS.BulkInsertTask 'TaskObject
On Error GoTo PackageError ImportFileToTempTable_DTS = True
Screen.MousePointer = vbHourglass
'Create connections, step, tasks
prgStatus.Value = 10
Set oConnection = oPackage.Connections.New("SQLOLEDB")
Set oStep = oPackage.Steps.New
Set oTask = oPackage.Tasks.New("DTSBulkInsertTask")
Set oCustomTask = oTask.CustomTask
'Set up and database connections
SetConnections oPackage, oConnection
With oStep
.name = "GenericPkgStep"
.ExecuteInMainThread = True
End With
'Customize the Task Object
With oCustomTask
.name = "GenericPkgTask"
.DataFile = strPath
.ConnectionID = 1
.DestinationTableName = strDBName & "..surrey_vip_import_temp"
.FieldTerminator = VBA.Chr(9)
.RowTerminator = vbCrLf '"\n\r"
End With
oStep.TaskName = oCustomTask.name
'Add the step
With oPackage
.Steps.Add oStep
.Tasks.Add oTask
.FailOnError = True
End With
'Run the package and release references.
prgStatus.Value = 40
oPackage.Execute
prgStatus.Value = prgStatus.Max
'Clean up
Set oConnection = Nothing
Set oCustomTask = Nothing
Set oTask = Nothing
Set oStep = Nothing
oPackage.UnInitialize
Screen.MousePointer = vbDefaultExit FunctionPackageError:
Dim sMsg As String
sMsg = "Package failed error: " & sErrorNumConv(Err.Number) & _
vbCrLf & Err.Description & vbCrLf & sAccumStepErrors(oPackage)
MsgBox sMsg, vbExclamation, oPackage.name
Set oConnection = Nothing
Set oCustomTask = Nothing
Set oTask = Nothing
Set oStep = Nothing
oPackage.UnInitialize
Screen.MousePointer = vbDefault
prgStatus.Value = 0
ImportFileToTempTable_DTS = False
End FunctionPrivate Function sAccumStepErrors(ByVal oPackage As DTS.Package) As String
Dim oStep As DTS.Step
Dim sMessage As String
Dim lErrNum As Long
Dim sDescr As String
Dim sSource As String 'Look for steps that completed and failed.
For Each oStep In oPackage.Steps
If oStep.ExecutionStatus = DTSStepExecStat_Completed Then
If oStep.ExecutionResult = DTSStepExecResult_Failure Then
'Get the step error information and append it to the message.
oStep.GetExecutionErrorInfo lErrNum, sSource, sDescr
sMessage = sMessage & vbCrLf & _
"Step " & oStep.name & " failed, error: " & _
sErrorNumConv(lErrNum) & vbCrLf & sDescr & vbCrLf
End If
End If
NextsAccumStepErrors = sMessage
End Function
Private Function sErrorNumConv(ByVal lErrNum As Long) As String
If lErrNum < 65536 And lErrNum > -65536 Then
sErrorNumConv = "x" & Hex(lErrNum) & ", " & CStr(lErrNum)
Else
sErrorNumConv = "x" & Hex(lErrNum) & ", x" & _
Hex(lErrNum And -65536) & " + " & CStr(lErrNum And 65535)
End If
End Function
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货