如何将查询写入外部数据源中

[小炮叔]

我想将查询的结果写入ACCESS表中或者EXCEL....请高手赐教

[huailairen]

用openrowset
写入。

[superwz]

Dim s As String
Dim rs1 As ADODB.Recordset
Dim cn1 As ADODB.Connection
On Error Resume Next
Set cn1 = New ADODB.Connection
Dim cnstr As String
Dim sum As Long
Dim j As Integer
Dim all(30)
sum = 0

Set xlapp = CreateObject("Excel.Application") '创建EXCEL应用类
xlapp.Visible = True '设置EXCEL可见
xlapp.WindowState = 2 '最小化
Set xlBook = xlapp.Workbooks.Open(App.Path & "\record.xls") '打开EXCEL工作簿
Set xlsheet = xlBook.Worksheets(1) '打开EXCEL工作表
xlsheet.Activate
ActiveSheet.Range("A1:B50") = "" '清空
'xlsheet.Range("a1:b50").Value = "" '
' xlsheet.Cells(1, 1) = "abc" '给单元格1行驶列赋值
' xlBook.RunAutoMacros (xlAutoOpen) 运行EXCEL中的启动宏
' List1.Clear
i = 0
cn1.ConnectionString = "Password=123;User ID=sa;Data Source=123;"
cn1.Open

Set rs1 = New ADODB.Recordset
sel = "SELECT InfoCode, COUNT(*) AS aaa From ssdCustomTailorTable WHERE (RecTelNo LIKE '13%') GROUP BY InfoCode"
rs1.Open sel, cn1, adOpenDynamic, adLockOptimistic, adCmdText
ProgressBar1.Value = Max
' StatusBar2.SimpleText = "............"
Do While Not rs1.EOF

Open App.Path & "\system.ini" For Input As #2

Do While Not EOF(2)
Line Input #2, s
If rs1(0).Value = Val(Trim(s)) Then
i = i + 1
ProgressBar1.Value = 100 \ i
List1.AddItem rs1(0).Value & " " & rs1(1).Value
Open App.Path & "\record.txt" For Append As #1
Print #1, rs1(0).Value, rs1(1).Value
Close #1
xlsheet.Cells(i, 1) = rs1(0).Value
xlsheet.Cells(i, 2) = rs1(1).Value
all(i) = rs1(1).Value
' Debug.Print xlSheet.Cells(i, 2)
sum = sum + xlsheet.Cells(i, 2)
End If
Loop

Close #2

rs1.MoveNext
Loop
xlsheet.Cells(i + 1, 2) = sum
' Debug.Print sum
Text1.Text = sum
rs1.Close
cn1.Close

ProgressBar1.Value = 0
xlsheet.Close

Set xlapp = Nothing

'