MS SQLSERVER的DTS是个很强大的工具，数据导入导出转换很好很强大。可惜有点小小的遗憾，就是不能设定导出导入全部表记录的指定前N条记录，虽然在工具里有个“Query Builder”来制定导入导出，但却只能控制一张表。不能实现多对多的同时控制（如导出导入全部表记录的指定前N条记录到对应的目标数据库表），这个是MS没考虑到的地方。
我想了个办法能决绝这个问题，只是还是不太方便。思路是这样的：要导出导入全部表记录的指定前N条记录到对应的目标数据库表时，在DTS工具里创建好包，这个时候不考虑要导入导出的是否是前N条记录，直接保存包为VB文件（就是*.bas,VB的模块文件），最后来修改这个保存的包文件（*.bas文件）里的SQL语句。
就是如“[你的字段] From [数据库].[你的表名]” 改写为“[你的字段] From [数据库].[你的表名] Whrer [你的字段] in (Select to 10 [你的字段] From [数据库].[你的表名])”的形式。
如：原句“select [CategoryID],[CategoryName],[Description],[Picture] from [Northwind].[dbo].[Categories]”
改写为"select [CategoryID],[CategoryName],[Description],[Picture] from [Northwind].[dbo].[Categories] where [Picture] in( select top 10 [Picture] from [Northwind].[dbo].[Categories])"
然后在VB里执行这个改写的DTS包（*.bas）就达到目的了。
当然如果你的表很多，有上100上1000个那，恐怕手动改很是苦头，
于是下面用VB的正册表达式来批量替换改写上面的那个形式就省心了。
在VB工程中引用：
Microsoft DTSPackage Object Library
Microsoft VBScript Regular Expressions 5.5
Microsoft Scripting Runtime
分别用于DTS，正册表达式，FileSystemObject对象
本例主要技巧和应用在Function TestRegExp(myString As String)这个过程
以下为代码文件
'*********************************************************************
DTS-Tool.vbp
'---------------
Type=Exe
Reference=*/G{00020430-0000-0000-C000-000000000046}#2.0#0#../../../../WINDOWS/system32/stdole2.tlb#OLE Automation
Reference=*/G{10010001-EB1C-11CF-AE6E-00AA004A34D5}#2.0#0#../../../../Program Files/Microsoft SQL Server/80/Tools/Binn/dtspkg.dll#Microsoft DTSPackage Object Library
Reference=*/G{3F4DACA7-160D-11D2-A8E9-00104B365C9F}#5.5#0#../../../../WINDOWS/system32/vbscript.dll/3#Microsoft VBScript Regular Expressions 5.5
Reference=*/G{420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#../../../../WINDOWS/system32/scrrun.dll#Microsoft Scripting Runtime
Reference=*/G{0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}#1.0#0#../../../../WINDOWS/system32/msscript.ocx#Microsoft Script Control 1.0
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; mscomctl.ocx
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0; comdlg32.ocx
Form=DTS-Tool.frm
Module=Module1; Module1.bas
IconForm="Form1"
Startup="Form1"
HelpFile=""
Title="DTS-Tool"
Command32=""
Name="DTSTool"
HelpContextID="0"
Description="DTS TOOL FOR MS SqlSever DTS By wgscd"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionComments="By wgscd"
VersionCompanyName="wgscd"
VersionFileDescription="DTS-Tool For MS SqlServer DTS"
VersionLegalCopyright="DTS-Tool"
VersionLegalTrademarks="DTS-Tool"
VersionProductName="DTS-Tool"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1
'*********************************************************************
DTS-Tool.frm
'---------------
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "comdlg32.ocx"
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "DTS-Tool By wgscd"
ClientHeight = 5265
ClientLeft = 45
ClientTop = 435
ClientWidth = 7770
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5265
ScaleWidth = 7770
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command2
Caption = "设定"
Height = 495
Left = 5640
TabIndex = 3
Top = 240
Width = 1215
End
Begin VB.ListBox List1
Height = 3840
Left = 480
TabIndex = 2
Top = 1200
Width = 6375
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 6960
Top = 4320
_ExtentX = 847
_ExtentY = 847
_Version = 327681
End
Begin VB.TextBox Text1
Height = 495
Left = 2040
TabIndex = 1
Text = "10"
Top = 240
Width = 1695
End
Begin VB.CommandButton Command1
Caption = "添加DTS包文件"
Height = 495
Left = 3840
TabIndex = 0
Top = 240
Width = 1695
End
Begin VB.Label Label1
Caption = "表返回记录数（Top ）"
Height = 495
Left = 480
TabIndex = 4
Top = 240
Width = 1215
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function EbExecuteLine Lib "vba6.dll" (ByVal pStringToExec As Long, ByVal Unknownn1 As Long, ByVal Unknownn2 As Long, ByVal fCheckOnly As Long) As Long
Dim MyCount As Integer
Public Function ExecuteLine(sCode As String, Optional fCheckOnly As Boolean) As Boolean
ExecuteLine = EbExecuteLine(StrPtr(sCode), 0&, 0&, Abs(fCheckOnly)) = 0
End Function
'
Function TestRegExp(myString As String)
Dim objMatch, colMatches, RetStr
Set objregexp = New RegExp
objregexp.Global = True
objregexp.Pattern = "(/[/w+/]) from (.*/[/w+/])"""
' Set colMatches = objregexp.Execute(myString)
' For Each objMatch In colMatches
' RetStr = objMatch.Value
' Next
RetStr = objregexp.Replace(myString, "$1 from $2 where $1 in( select top " & Text1.Text & " $1 from $2)""")
'MsgBox RetStr
TestRegExp = RetStr
End Function
Private Sub Command1_Click()
List1.Clear
CommonDialog1.DialogTitle = "select DTS pachage file (*.bas)"
CommonDialog1.Filter = "*.bas(VB模块文件)|*.bas"
CommonDialog1.Flags = cdlOFNAllowMultiselect + cdlOFNExplorer
CommonDialog1.MaxFileSize = 512
CommonDialog1.CancelError = True
CommonDialog1.FileName = ""
Dim filenames
On Error GoTo Errhandler
CommonDialog1.ShowOpen
'MsgBox CommonDialog1.FileName
If CommonDialog1.FileName <> "" Then '判断选择了文件
filenames = Split(CommonDialog1.FileName, Chr(0)) '' filenames将会得到split从对话框中得到的一大串包含所选文件名的集合，他的大概形式为：路径名（索引为0）Chr(0) 文件1（索引为2）……
If UBound(filenames) > 1 Then 'UBound即求出文件名集合总数，如果大于1，说明包含了路径和文件名，就要来这里处理了
Dim filenamesCount As Integer
filenamesCount = UBound(filenames) '这是为下列数组循环准备的最大值
Dim i As Integer
For i = 1 To filenamesCount
List1.AddItem filenames(0) & "/" & filenames(i) '' 将路径和文件名集合每一项连接起来，放入list1
Next i
Else
List1.AddItem Me.CommonDialog1.FileName '' 如果只是单选了一个文件，
End If
End If
readFile (CommonDialog1.FileName)
Exit Sub
Errhandler: ''如果选择了CANCEL 就退出过程
'MsgBox "err"
Exit Sub
End Sub
Function readFile(ByVal strfilePath As String) As String
Dim fsoTest As New FileSystemObject, f As TextStream
Dim str As String
Set f = fsoTest.OpenTextFile(strfilePath, ForReading)
If Not f.AtEndOfStream Then
str = f.ReadAll
readFile = str
Else
readFile = ""
End If
f.Close
Set f = Nothing
End Function
Function writeFile(ByVal strFile As String, ByVal strVal As String) As Boolean
On Error GoTo er
Dim fso As New FileSystemObject, f As TextStream
Set f = fso.CreateTextFile(strFile, True)
f.Write (strVal)
f.Close
Set f = Nothing
writeFile = True
Exit Function
er:
writeFile = False
Exit Function
End Function
Private Sub Command2_Click()
If List1.ListCount <= 0 Then
MsgBox "请先添加DTS包文件（*.bas）"
Exit Sub
End If
If Trim(Text1.Text) = "" Then
MsgBox "设置DTS表返回记录条数不能为空 ！"
Exit Sub
'If Not IsNumeric(Text1.Text) Then
'
' MsgBox "请输入数值"
' End If
'Exit Sub
End If
Dim i As Integer
For i = 0 To List1.ListCount - 1
writeDTSPackage List1.List(i)
Next
MsgBox "执行完毕！"
End Sub
Sub writeDTSPackage(ByVal strFile As String)
Dim str As String
str = TestRegExp(readFile(strFile))
writeFile strFile, str
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 48 To 57 '0-9
Exit Sub
Case 8
Exit Sub
Case 8
Case 13
Exit Sub
Case Else
KeyAscii = 0
MsgBox "请输入数值"
End Select
End Sub
'*********************************************************************
DTS-Tool.vbw
'---------------
Form1 = 44, 58, 1013, 675, Z, 22, 29, 749, 518, C
Module1 = 44, 58, 664, 675,
附带说明：
如要执行SQLServer里的DTS包文件（就是保存包的时候选择的是sqlserver），只要下面的过程
Private Sub SimpleExecutePackage()
Dim oPKG As New DTS.Package
oPKG.LoadFromSQLServer "guangshu", , , _
DTSSQLStgFlag_UseTrustedConnection, , , , "pk"
oPKG.Execute
oPKG.UnInitialize
Set oPKG = Nothing
End Sub
"guangshu"为数据库名，"pk"为DTS包名
扫一扫
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
