Параметризированный запрос к БД Oracl из VBA.

[ivan.tiran]

Сообщение от Аватар

1 раз перед присвоениями

Спасибо. Запись прошла. Но у меня новая проблема. Я когда в цикле делаю execute, он проходит один раз. Что я делаю не так?

Вот мой код

Private Sub WriteInIzmiran(Item As Outlook.MailItem, hType As HeaderType, workDirectory As String, databaseName As String, databaseUser As String, databaseUserPassword As String) 'ïðîöåäóðà çàïèñè âëîæåíèé â Izmiran
    Dim strSql As String
    Dim driverParameters As String
    Dim con As Object
    Dim oCmd As Object
    Dim ind As Integer
    Dim binaryParameter As ADODB.Parameter
    Dim binaryStream As Stream

    
    driverParameters = "Provider=OraOLEDB.oracle;USER ID=" & databaseUser & ";Password=" & databaseUserPassword & ";Data Source=" & databaseName
    
    strSql = "INSERT INTO IZMIRAN(N_MES,NAME_F,T_TXT,T_DOC,D_MES) VALUES((select case when MAX(N_MES) is not null then MAX(N_MES) + ? else 1 end  AS MAX_N_MES from IZMIRAN),?,?,?,?)"
    
    Set con = CreateObject("ADODB.connection")
    con.ConnectionString = driverParameters
    con.Open
    Set oCmd = CreateObject("ADODB.Command")
    oCmd.ActiveConnection = con
    oCmd.CommandText = strSql
    oCmd.CommandType = adCmdText

    oCmd.NamedParameters = False
    
    MsgBox "first"
    
    oCmd.Prepared = True
    
    Select Case hType
        Case PROGNOZ
            oCmd.Parameters.Append oCmd.CreateParameter("N_MES", adBigInt, adParamInput, , 1)
            oCmd.Parameters.Append oCmd.CreateParameter("NAME_F", adVarChar, adParamInput, Len(Item.Subject), Item.Subject)
            oCmd.Parameters.Append oCmd.CreateParameter("T_TXT", adLongVarChar, adParamInput, 4000, Item.Body)
            oCmd.Parameters.Append oCmd.CreateParameter("T_DOC", adLongVarBinary, adParamInput, 4000, Null)
            oCmd.Parameters.Append oCmd.CreateParameter("D_MES", adDate, adParamInput, , Item.ReceivedTime)
            
            oCmd.Execute
        Case Else
        
            ind = 0
            Set binaryStream = New Stream
                
            For Each at In Item.Attachments
                If ind = 0 Then
                    oCmd.Parameters.Append oCmd.CreateParameter("N_MES", adBigInt, adParamInput, , 1)
                Else
                    oCmd.Parameters.Append oCmd.CreateParameter("N_MES", adBigInt, adParamInput, , 0)
                End If
                oCmd.Parameters.Append oCmd.CreateParameter("NAME_F", adVarChar, adParamInput, Len(Item.Subject), Item.Subject)
                
                
                
                If getFileType(at.fileName) = TXT Then
                
                MsgBox "TEXT " & at.fileName
                    oCmd.Parameters.Append oCmd.CreateParameter("T_TXT", adLongVarChar, adParamInput, 4000, readTextFromFile(workDirectory & at.fileName))
                    oCmd.Parameters.Append oCmd.CreateParameter("T_DOC", adLongVarBinary, adParamInput, 4000, Null)
                Else
                
                    MsgBox "Binary " & at.fileName

                    binaryStream.Open
                    binaryStream.Type = adTypeBinary
                    binaryStream.LoadFromFile (workDirectory & at.fileName)
                    binaryStream.Position = 0

                    Set binaryParameter = oCmd.CreateParameter("T_DOC", adLongVarBinary, adParamInput, binaryStream.Size)
                    binaryParameter.AppendChunk binaryStream.Read

                    oCmd.Parameters.Append oCmd.CreateParameter("T_TXT", adLongVarChar, adParamInput, 4000, Null)
                    oCmd.Parameters.Append binaryParameter
                    binaryStream.Close
                End If
                
                oCmd.Parameters.Append oCmd.CreateParameter("D_MES", adDate, adParamInput, , Item.ReceivedTime)
    
                oCmd.Execute
    
                MsgBox "qwerty"

                ind = ind + 1
            Next at
        End Select
    
    Set oCmd = Nothing
    con.Close
    Set con = Nothing
    
    MsgBox "END"
    
End Sub

[ivan.tiran]

Ура! Получилось!

Private Sub WriteInIzmiran(Item As Outlook.MailItem, hType As HeaderType, workDirectory As String, databaseName As String, databaseUser As String, databaseUserPassword As String) 'ïðîöåäóðà çàïèñè âëîæåíèé â Izmiran
    Dim strSql As String
    Dim driverParameters As String
    Dim con As Object
    Dim oCmd As Object
    Dim ind As Integer
    Dim binaryParameter As ADODB.Parameter
    Dim binaryStream As Stream
    
    driverParameters = "Provider=OraOLEDB.oracle;USER ID=" & databaseUser & ";Password=" & databaseUserPassword & ";Data Source=" & databaseName
    
    strSql = "INSERT INTO IZMIRAN(N_MES,NAME_F,T_TXT,T_DOC,D_MES) VALUES((select case when MAX(N_MES) is not null then MAX(N_MES) + ? else 1 end  AS MAX_N_MES from IZMIRAN),?,?,?,?)"
    
    Set con = CreateObject("ADODB.connection")
    con.ConnectionString = driverParameters
    con.Open
    Set oCmd = CreateObject("ADODB.Command")
    oCmd.ActiveConnection = con
    oCmd.CommandText = strSql
    oCmd.CommandType = adCmdText

    oCmd.NamedParameters = False
    oCmd.Prepared = True
    
    Select Case hType
        Case PROGNOZ
            oCmd.Parameters.Append oCmd.CreateParameter("N_MES", adBigInt, adParamInput, , 1)
            oCmd.Parameters.Append oCmd.CreateParameter("NAME_F", adVarChar, adParamInput, Len(Item.Subject), Item.Subject)
            oCmd.Parameters.Append oCmd.CreateParameter("T_TXT", adLongVarChar, adParamInput, 4000, Item.Body)
            oCmd.Parameters.Append oCmd.CreateParameter("T_DOC", adLongVarBinary, adParamInput, 4000, Null)
            oCmd.Parameters.Append oCmd.CreateParameter("D_MES", adDate, adParamInput, , Item.ReceivedTime)
            
            oCmd.Execute
        Case Else
        
            ind = 0
            Set binaryStream = New Stream
                
            For Each at In Item.Attachments
                           
                If ind = 0 Then
                    oCmd.Parameters.Append oCmd.CreateParameter("N_MES", adBigInt, adParamInput, , 1)
                Else
                    oCmd.Parameters.Append oCmd.CreateParameter("N_MES", adBigInt, adParamInput, , 0)
                End If
                oCmd.Parameters.Append oCmd.CreateParameter("NAME_F", adVarChar, adParamInput, Len(at.fileName), at.fileName)

                If getFileType(at.fileName) = TXT Then
                    oCmd.Parameters.Append oCmd.CreateParameter("T_TXT", adLongVarChar, adParamInput, 4000, readTextFromFile(workDirectory & at.fileName))
                    oCmd.Parameters.Append oCmd.CreateParameter("T_DOC", adLongVarBinary, adParamInput, 4000, Null)
                Else
                    binaryStream.Open
                    binaryStream.Type = adTypeBinary
                    binaryStream.LoadFromFile (workDirectory & at.fileName)
                    binaryStream.Position = 0

                    Set binaryParameter = oCmd.CreateParameter("T_DOC", adLongVarBinary, adParamInput, binaryStream.Size)
                    binaryParameter.AppendChunk binaryStream.Read

                    oCmd.Parameters.Append oCmd.CreateParameter("T_TXT", adLongVarChar, adParamInput, 4000, Null)
                    oCmd.Parameters.Append binaryParameter
                    binaryStream.Close
                End If
                
                oCmd.Parameters.Append oCmd.CreateParameter("D_MES", adDate, adParamInput, , Item.ReceivedTime)
                oCmd.Execute
                
                Do While oCmd.Parameters.Count > 0
                    oCmd.Parameters.Delete (0)
                Loop
                ind = ind + 1
            Next at
        End Select
    
    Set oCmd = Nothing
    con.Close
    Set con = Nothing
End Sub

Надо было

                Do While oCmd.Parameters.Count > 0
                    oCmd.Parameters.Delete (0)
                Loop

после oCmd.exec сделать.

Помогите теперь дату и время в БД вставить. В соседней теме https://www.programmersforum.ru/showthread.php?t=330730

[ivan.tiran]

Спасибо всем, с датой и временем проблему решили.