用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