none
Retornar uma consulta apra verificar se faz update ou insert RRS feed

  • Pergunta

  • Boa tarde,

    Alguém poderia me ajudar no código abaixo,  eu tenho uma planilha com 3 colunas ntab, prod, vlr, e tenho uma tabela no oracle com os campos nutab, codprod, vlrnota, dhalter 

    Eu gostaria de que quando fosse executado o codigo, ele verificasse se o produto naquela nutab já existir fazer update (se possível fazer update só do que alterou), se o produto não tiver ainda no oracle fazer o insert.

    Atualmente o codigo funciona mais não faz insert, somente update de tudo, acho que nãoe sta funcionando o sql que verifica se tem o produto na mesma nutab.

    Também não consegui que no campo dhalter no insert gravasse a hora da alteracao, esta inserindo somente a data.

    Agradeço a ajuda.

    Sub ImportaDados() Dim sql As String Dim ntab As String Dim prod As String Dim vlr As String Dim V3 As String Dim ws1 As Worksheet Dim X As Integer Dim lngLastRow As Long 'Define Worksheet Set ws1 = Sheets("Plan1") 'Define last row lngLastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row Dim cnn As ADODB.Connection Dim MyRecordSet As ADODB.Recordset Dim SqlString As String Set cnn = New ADODB.Connection ' Set properties of the Connection. cnn.ConnectionString = "Provider=MSDAORA;Data Source=orcl;user ID=TESTE;password=TESTE;" cnn.ConnectionTimeout = 90 ' Open the connection. cnn.Open ' Find out if the attempt to connect worked. If cnn.State = adStateOpen Then Else MsgBox "Sorry. Connection Failed" End If X = 0 'Inicia Loop ############################################################################## Do Until X = lngLastRow 'Define Variaveis para query ntab = "'" & ws1.Range("A3").Offset(X, 0) & "'" prod = "'" & ws1.Range("B3").Offset(X, 0) & "'" vlr = "'" & ws1.Range("C3").Offset(X, 0) & "'" V3 = "'" & Date & "'" 'Verifica se o produto já existe na nutab sql = "SELECT count(codprod)" & _ " FROM AD_TGFEXC exc " & _ " WHERE CODPROD = " & prod & " AND NUTAB = " & ntab & ";" 'Define Query If sql > "0" Then SqlString = "update AD_TGFEXC set VLRVENDA = " & vlr & "WHERE NUTAB = " & ntab & " AND CODPROD = " & prod & "" Else SqlString = "Insert into AD_TGFEXC(NUTAB, CODPROD, VLRVENDA, DHALTER) Values(" & ntab & "," & prod & "," & vlr & "," & "TO_DATE(" & V3 & ", 'DD/MM/YYYY HH24:MI:SS'))"

    End If Set MyRecordSet = New ADODB.Recordset MyRecordSet.Open SqlString, cnn, adOpenDynamic, adLockOptimistic 'Increment X X = X + 1 'Close Loop ################################################################################### Loop ' Close the connection. cnn.Close Set cnn = Nothing MsgBox " Dados Atualizados Com Sucesso" End Sub



    • Editado Emerson Rosa quarta-feira, 6 de maio de 2015 19:30
    quarta-feira, 6 de maio de 2015 18:56

Respostas

  • Sub ImportaDados()
        Dim sql As String
        Dim ntab As String
        Dim prod As String
        Dim vlr As String
        Dim V3 As String
        Dim ws1 As Worksheet
        Dim X As Integer
        Dim lngLastRow As Long
        Dim cnn As ADODB.Connection
        Dim MyRecordSet As ADODB.Recordset
        Dim rstCheck As ADODB.Recordset
        Dim SqlString As String
        
        'Define Worksheet
        Set ws1 = Sheets("Plan1")
        'Define last row
        lngLastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
        Set cnn = New ADODB.Connection
        ' Set properties of the Connection.
        cnn.ConnectionString = "Provider=MSDAORA;Data Source=orcl;user ID=TESTE;password=TESTE;"
        cnn.ConnectionTimeout = 90
        ' Open the connection.
        cnn.Open
        ' Find out if the attempt to connect worked.
        If cnn.State = adStateOpen Then
            
        Else
            MsgBox "Sorry. Connection Failed"
        End If
        
        X = 0
        
        'Inicia Loop ##############################################################################
        Do Until X = lngLastRow
            
            'Define Variaveis para query
            ntab = "'" & ws1.Range("A3").Offset(X, 0) & "'"
            prod = "'" & ws1.Range("B3").Offset(X, 0) & "'"
            vlr = "'" & ws1.Range("C3").Offset(X, 0) & "'"
            V3 = "'" & Date & "'"
            
            'Verifica se o produto já existe na nutab
            sql = "SELECT TOP 1 1" & _
            " FROM AD_TGFEXC exc " & _
            " WHERE CODPROD = " & prod & " AND NUTAB = " & ntab & ";"
            
            Set rstCheck = cnn.Execute(sql)
            'Define Query
            
            If Not rstCheck.EOF Then
                SqlString = "update AD_TGFEXC set VLRVENDA = " & vlr & "WHERE NUTAB = " & ntab & " AND CODPROD = " & prod & ""
            Else
                SqlString = "Insert into AD_TGFEXC(NUTAB, CODPROD, VLRVENDA, DHALTER) Values(" & ntab & "," & prod & "," & vlr & "," & "TO_DATE(" & V3 & ", 'DD/MM/YYYY HH24:MI:SS'))"
            End If
            
            rstCheck.Close
            Set rstCheck = Nothing
            
            Set MyRecordSet = New ADODB.Recordset
            MyRecordSet.Open SqlString, cnn, adOpenDynamic, adLockOptimistic
            
            'Increment X
            X = X + 1
            
            'Close Loop ###################################################################################
        Loop
        
        ' Close the connection.
        cnn.Close
        Set cnn = Nothing
        MsgBox " Dados Atualizados Com Sucesso"
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br


    quarta-feira, 6 de maio de 2015 23:50
    Moderador

Todas as Respostas

  • Sub ImportaDados()
        Dim sql As String
        Dim ntab As String
        Dim prod As String
        Dim vlr As String
        Dim V3 As String
        Dim ws1 As Worksheet
        Dim X As Integer
        Dim lngLastRow As Long
        Dim cnn As ADODB.Connection
        Dim MyRecordSet As ADODB.Recordset
        Dim rstCheck As ADODB.Recordset
        Dim SqlString As String
        
        'Define Worksheet
        Set ws1 = Sheets("Plan1")
        'Define last row
        lngLastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
        Set cnn = New ADODB.Connection
        ' Set properties of the Connection.
        cnn.ConnectionString = "Provider=MSDAORA;Data Source=orcl;user ID=TESTE;password=TESTE;"
        cnn.ConnectionTimeout = 90
        ' Open the connection.
        cnn.Open
        ' Find out if the attempt to connect worked.
        If cnn.State = adStateOpen Then
            
        Else
            MsgBox "Sorry. Connection Failed"
        End If
        
        X = 0
        
        'Inicia Loop ##############################################################################
        Do Until X = lngLastRow
            
            'Define Variaveis para query
            ntab = "'" & ws1.Range("A3").Offset(X, 0) & "'"
            prod = "'" & ws1.Range("B3").Offset(X, 0) & "'"
            vlr = "'" & ws1.Range("C3").Offset(X, 0) & "'"
            V3 = "'" & Date & "'"
            
            'Verifica se o produto já existe na nutab
            sql = "SELECT TOP 1 1" & _
            " FROM AD_TGFEXC exc " & _
            " WHERE CODPROD = " & prod & " AND NUTAB = " & ntab & ";"
            
            Set rstCheck = cnn.Execute(sql)
            'Define Query
            
            If Not rstCheck.EOF Then
                SqlString = "update AD_TGFEXC set VLRVENDA = " & vlr & "WHERE NUTAB = " & ntab & " AND CODPROD = " & prod & ""
            Else
                SqlString = "Insert into AD_TGFEXC(NUTAB, CODPROD, VLRVENDA, DHALTER) Values(" & ntab & "," & prod & "," & vlr & "," & "TO_DATE(" & V3 & ", 'DD/MM/YYYY HH24:MI:SS'))"
            End If
            
            rstCheck.Close
            Set rstCheck = Nothing
            
            Set MyRecordSet = New ADODB.Recordset
            MyRecordSet.Open SqlString, cnn, adOpenDynamic, adLockOptimistic
            
            'Increment X
            X = X + 1
            
            'Close Loop ###################################################################################
        Loop
        
        ' Close the connection.
        cnn.Close
        Set cnn = Nothing
        MsgBox " Dados Atualizados Com Sucesso"
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br


    quarta-feira, 6 de maio de 2015 23:50
    Moderador
  • Muito Obrigado Felipe, 100%, quebrei a cabeça e não tinha conseguido, sou iniciante em VB. Muito Obrigado.
    sábado, 9 de maio de 2015 00:51