mdltruncatetable.bas

數據庫轉資料程式用SQL SERVER DTS 轉表到另一能SQL DB上

Attribute VB_Name = "mdlTruncateTable"
Option Explicit

Dim mConn As ADODB.Connection

Public Function TruncateTable(ByVal wCServerName As String, _
                              ByVal wCDBName As String, _
                              ByVal wCUserName As String, _
                              ByVal wCPassWord As String, _
                              ByVal mTableArr As Variant) As Boolean
   
   Dim mConnString As String
   Dim I As Long, X As Long
   On Error GoTo ErrorHandle
   
   mConnString = "Provider=SQLOLEDB.1;" & _
                 "Password=" & wCPassWord & ";" & _
                 "Persist Security Info=True;" & _
                 "User ID=" & wCUserName & ";" & _
                 "Initial Catalog=" & wCDBName & ";" & _
                 "Data Source=" & wCServerName
   Set mConn = New ADODB.Connection
   mConn.Open (mConnString)
   I = UBound(mTableArr)
   For X = 1 To I
      If mTableArr(X) <> "" Then
         mConn.Execute "truncate table " & mTableArr(X)
      End If
   Next
   mConn.Execute "truncate table iemr03h"
   mConn.Execute "truncate table iemr03d1"
   mConn.Execute "truncate table iemr03d2"
   mConn.Execute "truncate table iemr03d3"
   mConn.Execute "truncate table iemr03d4"
   mConn.Execute "truncate table iemr03d5"
   mConn.Execute "truncate table iemr03d6"
   mConn.Execute "truncate table iemr03d7"
   mConn.Close
   TruncateTable = True
   
   Exit Function
ErrorHandle:
   TruncateTable = False
   Call MsgBox("ErrNumber:" & CStr(Err.Number) & vbCrLf & _
          Err.Description, vbOKOnly + vbExclamation)
End Function

'-----------by Fayth add at 2006/03/14--------
'-------------------称