为什么这会给我一个错误关闭对象时不允许操作。它适用于Select语句或delete语句。插入语句在toad上只需几秒钟。
错误发生在 - > do while not showList.eof
代码是:
Option Explicit
Dim dbType, dbHost, dbName, dbUser, dbPass, outputFile, EMail, subj, body, smtp, smtpPort, sqlstr, sqlstr2
'''''''''''''''''
' Configuration '
'''''''''''''''''
dbType = "oracle" ' Valid values: "oracle", "sqlserver", "mysql"
dbHost = "192.168.10.20" ' Hostname of the database server
dbName = "dwh" ' Name of the database/SID
dbUser = "ABC" ' Name of the user
dbPass = "PASSWORD" ' Password of the above-named user
outputFile = "C:\New folder\DailyCounts\INSERT_CALL_HST.csv" ' Path and file name of the output CSV file
EMail = "" ' Enter email here should you wish to email the CSV file (as attachment); if no email, leave it as empty string ""
subj = "CALL HST" ' The subject of your email; required only if you send the CSV over email
body = "Done!" ' The body of your email; required only if you send the CSV over email
smtp = "192.168.110.3" ' Name of your SMTP server; required only if you send the CSV over email
smtpPort = 25 ' SMTP port used by your server, usually 25; required only if you send the CSV over email
sqlstr = "INSERT INTO DAILY_CALL_HST select trans_date, round(sum(change_amount)), sum(USAGE_AMOUNT) USAGE from " & _
"tdw.CALL_HIST_HOUR_SUMMARY where balance_id = 1 and TRANS_DATE = (SELECT TO_CHAR(SYSDATE, 'YYYYMMDD')-1 FROM DUAL) " & _
"group by trans_date order by 1"
'''''''''''''''''''''
' End Configuration '
'''''''''''''''''''''
Dim fso, conn
'Create filesystem object
Set fso = CreateObject("Scripting.FileSystemObject")
'Database connection info
Set conn = CreateObject("ADODB.connection")
conn.ConnectionTimeout = 20
conn.CommandTimeout = 40
If dbType = "oracle" Then
conn.Open ("Provider=OraOLEDB.Oracle;Data Source=192.168.10.20/dwh;User ID=" & dbUser & ";Password=" & dbPass & ";Persist Security Info=False")
ElseIf dbType = "sqlserver" Then
conn.Open ("Driver={SQL Server};Server=" & dbHost & ";Database=" & dbName & ";Uid=" & dbUser & ";Pwd=" & dbPass & ";")
ElseIf dbType = "mysql" Then
conn.Open ("DRIVER={MySQL ODBC 3.51 Driver}; SERVER=" & dbHost & ";PORT=3306;DATABASE=" & dbName & "; UID=" & dbUser & "; PASSWORD=" & dbPass & "; OPTION=3")
End If
' Subprocedure to generate data. Two parameters:
' 1. fPath=where to create the file
' 2. sqlstr=the database query
Sub MakeDataFile(fPath, sqlstr)
Dim a, showList, intcount
Set a = fso.CreateTextFile(fPath)
Set showList = conn.Execute(sqlstr)
For intcount = 0 To showList.Fields.Count - 1
If intcount <> showList.Fields.Count - 1 Then
a.Write """" & showList.Fields(intcount).Name & ""","
Else
a.Write """" & showList.Fields(intcount).Name & """"
End If
Next
a.WriteLine ""
Do While Not showList.EOF
For intcount = 1 To showList.Fields.Count - 1
If intcount <> showList.Fields.Count - 1 Then
a.Write """" & showList.Fields(intcount).Value & ""","
Else
a.Write """" & showList.Fields(intcount).Value & """"
End If
Next
a.WriteLine ""
showList.MoveNext
Loop
showList.Close
Set showList = Nothing
Set a = Nothing
End Sub
' Call the subprocedure
Call MakeDataFile(outputFile, sqlstr)
' Close
Set fso = Nothing
conn.Close
Set conn = Nothing
If EMail <> "" Then
Dim objMessage
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "All recharges from vbs"
objMessage.From = EMail
objMessage.To = EMail
objMessage.TextBody = "Please see attached file."
objMessage.AddAttachment outputFile
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtp
objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = smtpPort
objMessage.Configuration.Fields.Update
objMessage.Send
End If
'You're all done!! Enjoy the file created.
MsgBox ("Data Writer Done!")