VBA代码中的插入语句出错

时间:2015-04-18 10:03:56

标签: vba

为什么这会给我一个错误关闭对象时不允许操作。它适用于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!")

enter image description here

0 个答案:

没有答案