Início
mi.bs 23/5/2022, 17:17Boa tarde,
Estou tendo dificuldades com este erro, podem me ajudar?
Estou tendo dificuldades com este erro, podem me ajudar?
- Código:
Sub AtualizaBD()
'Application.ScreenUpdating = False
'Application.EnableEvents = False
'Atualizar Regras no banco
Dim RS As New ADODB.Recordset
Dim FD As ADODB.Field
Dim SQL As String
Dim W As Worksheet
Dim Ln As Long
Dim Lin As Long
Dim L As Long
Dim Col As Integer
Sheets("Notas").Visible = True
Set W = Sheets("Notas")
Ln = 2
Col = 38
W.Select
W.Range("AL1").Select
Call ConectaBD
MDB.Execute ("Delete * From [TbRegras]")
Do While Ln <= 113
SQL = "INSERT INTO TbRegras"
SQL = SQL & "(ChaveRegraProdMes,Tipo,Regra,Mês,CRVendasQTD,CRVendasVolume,CRVolumeMin,Bolas,Gordura)"
SQL = SQL & " values "
SQL = SQL & " ('" & W.Cells(Ln, Col).Value & "', "
SQL = SQL & " '" & W.Cells(Ln, Col + 1).Value & " ',"
SQL = SQL & " '" & W.Cells(Ln, Col + 2).Value & " ',"
SQL = SQL & " '" & W.Cells(Ln, Col + 3).Value & " ',"
SQL = SQL & W.Cells(Ln, Col + 4).Value & " ,"
SQL = SQL & W.Cells(Ln, Col + 5).Value & " ,"
SQL = SQL & W.Cells(Ln, Col + 6).Value & " ,"
SQL = SQL & W.Cells(Ln, Col + 7).Value & " ,"
SQL = SQL & W.Cells(Ln, Col + 8).Value & " )"
RS.Open SQL, MDB
Ln = Ln + 1
Col = 38
Loop
MDB.Close
Sheets("Notas").Visible = False
Set W = Nothing
Set MDB = Nothing
Set RS = Nothing
Set FD = Nothing
'Atualizarbase
Sheets("BolasporFaixa").Visible = True
Sheets("BolasporFaixa").Select
Range("A4").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Set W = Sheets("BolasporFaixa")
Lin = 4
W.Select
W.Range("A4").Select
Call ConectaBD
SQL = "SELECT DISTINCT Passo2.[MATRICULA_VENDEDOR], sum( Passo2.[Bolas]) AS Bolas FROM Passo2 WHERE Passo2.[Bolas] Is Not Null GROUP BY Passo2.[MATRICULA_VENDEDOR];"
RS.Open SQL, MDB
Do Until RS.EOF = True
Range("A" & Lin) = RS.Fields(0)
Range("B" & Lin) = RS.Fields(1)
Range("C" & Lin) = RS.Fields(2)
Range("D" & Lin) = RS.Fields(3)
Range("E" & Lin) = RS.Fields(4)
Range("F" & Lin) = RS.Fields(5)
Range("G" & Lin) = RS.Fields(6)
RS.MoveNext
Lin = Lin + 1
Loop
RS.Close
MDB.Close
Set W = Nothing
Set MDB = Nothing
Set RS = Nothing
Set FD = Nothing
MsgBox "Obrigada por aguardar! As regras foram aplicadas e o simulador foi atualizado com sucesso!"
Sheets("BolasporFaixa").Visible = False
End Sub
