[Resolvido]lentidão na execução de rotina

Convidado 1/8/2020, 19:13

Convidado: Convidado

Mensagem nº1

[Resolvido]lentidão na execução de rotina

Mensagem Convidado 1/8/2020, 19:13

Senhores, Senhoras e afins

Estou com o seguinte problema.

Tenho uma tabela "Estoque" que é estática, ou seja so tenho a informação do que tem no momento.
Tenho uma outra tabela que tem o registro de movimentações (entradas e saídas do estoque)
Preciso atualizar uma terceira tabela que registra o inventário a cada dia primeiro do ano

Criei a rotina abaixo e ela funciona.
Acontece que não sei a causa, mas se mandar executar a rotina, o access não responde mais, e tenho que usar o gerenciador de tarefas para parar o programa.
Como precisava fazer isso, inclui um contador que para a rotina sempre que ela se repete a um certo número de repetições.
Ai reinicio a rotina do ponto que parou.
Fiz isso um certo número de vezes e ele disse que o PC não tinha mais recursos para executar a rotina. (acho que ele vai acumulando espaço usado na memória).
São 52000 mil itens e estou fazendo de 500 em 500 e isso consome 3 minutos. com isso preciso de horas para fazer uma rotina se o computador fizer.

Alguem pode dar uma olhada na rotina e dizer o que de errado estou fazendo.

Obrigado.

Private Sub GerBlocoH_Click()
Dim stDB As DAO.Database
Dim stEstFix As DAO.Recordset
Dim stEstVar As DAO.Recordset
Dim stEstInv As DAO.Recordset
Dim Criterio1 As String
Dim Criterio2 As String
Dim Codpass As String
Dim QTDfix As Variant
Dim QTDEst As Variant
Dim DatFix As Date
Dim Dat19 As Date
Dim Dat20 As Date
Dim jaPassei As String
Dim jaPassei1 As String

Dat19 = Me.Ano1
Dat20 = Me.AnoAtual

Set stDB = CurrentDb()
Set stEstFix = stDB.OpenRecordset("bk_EstoqueJunho20")
Set stEstVar = stDB.OpenRecordset("bkgeradorInventário")
Set stEstInv = stDB.OpenRecordset("bk_Inventario")
ContarPassadas = 0
Codpass = Me.PriCod
Criterio2 = "CODIGO = " & "'" & Codpass & "'"
stEstFix.FindFirst Criterio2

Do
Codpass = stEstFix!CODIGO
QTDfix = stEstFix!QTD_EM_ESTOQUE
DatFix = stEstFix!ULTIMA_ALTERACAO
Criterio1 = "CODIGO = " & "'" & Codpass & "'"
jaPassei = "N"
jaPassei1 = "N"

stEstVar.FindFirst Criterio1

If stEstVar.NoMatch = True Then
stEstInv.AddNew
stEstInv!CODIGO = stEstFix!CODIGO
stEstInv!NOME = stEstFix!NOME
stEstInv!UND_VENDA = stEstFix!UND_VENDA
stEstInv!Data = Dat20
If IsNull(stEstFix!QTD_EM_ESTOQUE) = True Or stEstFix!QTD_EM_ESTOQUE < 0 Then
QTDEst = 0
Else
QTDEst = stEstFix!QTD_EM_ESTOQUE
End If
stEstInv!QTD_EM_ESTOQUE = QTDEst
stEstInv!PRECO_DE_CUSTO = stEstFix!PRECO_DE_CUSTO
stEstInv!VL_ITEM = FormatNumber(QTDEst, 2) * FormatNumber(stEstFix!PRECO_DE_CUSTO, 2)
stEstInv!IND_PROP = ""
stEstInv!COD_PART = ""
stEstInv!TXT_COMPL = ""
stEstInv!COD_CTA = ""
stEstInv!VL_ITEM_IR = FormatNumber(QTDEst, 2) * FormatNumber(stEstFix!PRECO_DE_CUSTO, 2)
stEstInv.Update

stEstInv.AddNew
stEstInv!CODIGO = stEstFix!CODIGO
stEstInv!NOME = stEstFix!NOME
stEstInv!UND_VENDA = stEstFix!UND_VENDA
stEstInv!Data = Dat19
If IsNull(stEstFix!QTD_EM_ESTOQUE) = True Or stEstFix!QTD_EM_ESTOQUE < 0 Then
QTDEst = 0
Else
QTDEst = stEstFix!QTD_EM_ESTOQUE
End If
stEstInv!QTD_EM_ESTOQUE = QTDEst
stEstInv!PRECO_DE_CUSTO = stEstFix!PRECO_DE_CUSTO
stEstInv!VL_ITEM = FormatNumber(QTDEst, 2) * FormatNumber(stEstFix!PRECO_DE_CUSTO, 2)
stEstInv!IND_PROP = ""
stEstInv!COD_PART = ""
stEstInv!TXT_COMPL = ""
stEstInv!COD_CTA = ""
stEstInv!VL_ITEM_IR = FormatNumber(QTDEst, 2) * FormatNumber(stEstFix!PRECO_DE_CUSTO, 2)
stEstInv.Update
Else
Do
If stEstVar!saida = "X" Then
stEstVar.Edit
stEstVar!SaldoAntes = QTDfix
stEstVar!Saldo = QTDfix + stEstVar!QTD
stEstVar.Update
Else
stEstVar.Edit
stEstVar!SaldoAntes = QTDfix
stEstVar!Saldo = QTDfix - stEstVar!QTD
stEstVar.Update
End If
CODIGOpass = stEstVar!CODIGO
DATA_SAIDApass = stEstVar!DATA_SAIDA
ESTOQUE_NOMEpass = stEstVar!ESTOQUE_NOME
UNDpass = stEstVar!UND
QTDpass = stEstVar!QTD
VALOR_UNITARIOpass = stEstVar!VALOR_UNITARIO
Valor_Totalpass = stEstVar!Valor_Total
CFOPpass = stEstVar!CFOP
NCMpass = stEstVar!NCM
COMPRAS_NOMEpass = stEstVar!COMPRAS_NOME
CNPJpass = stEstVar!CNPJ
NOTAPass = stEstVar!NOTA
saidapass = stEstVar!saida
entradapass = stEstVar!entrada
Saldopass = stEstVar!Saldo
SaldoAntespass = stEstVar!SaldoAntes
QTDfix = stEstVar!Saldo

stEstVar.MoveNext
If stEstVar.NoMatch = True Then Exit Do

If (stEstVar!DATA_SAIDA < Dat20) And jaPassei = "N" Then
stEstInv.AddNew
stEstInv!CODIGO = CODIGOpass
stEstInv!NOME = ESTOQUE_NOMEpass
stEstInv!UND_VENDA = UNDpass
stEstInv!Data = Dat20
If IsNull(Saldopass) = True Or Saldopass < 0 Then
QTDEst = 0
Else
QTDEst = Saldopass
End If
stEstInv!QTD_EM_ESTOQUE = FormatNumber(QTDEst, 2)
stEstInv!PRECO_DE_CUSTO = VALOR_UNITARIOpass
stEstInv!VL_ITEM = FormatNumber(QTDEst, 2) * FormatNumber(VALOR_UNITARIOpass, 2)
stEstInv!IND_PROP = ""
stEstInv!COD_PART = ""
stEstInv!TXT_COMPL = ""
stEstInv!COD_CTA = ""
stEstInv!VL_ITEM_IR = FormatNumber(QTDEst, 2) * FormatNumber(VALOR_UNITARIOpass, 2)
stEstInv.Update
jaPassei = "S"
End If
If stEstVar!CODIGO <> Codpass And DATA_SAIDApass < Dat20 And jaPassei1 = "N" Then
stEstInv.AddNew
stEstInv!CODIGO = CODIGOpass
stEstInv!NOME = ESTOQUE_NOMEpass
stEstInv!UND_VENDA = UNDpass
stEstInv!Data = Dat19
If IsNull(Saldopass) = True Or Saldopass < 0 Then
QTDEst = 0
Else
QTDEst = Saldopass
End If
stEstInv!QTD_EM_ESTOQUE = FormatNumber(QTDEst, 2)
stEstInv!PRECO_DE_CUSTO = VALOR_UNITARIOpass
stEstInv!VL_ITEM = FormatNumber(QTDEst, 2) * FormatNumber(VALOR_UNITARIOpass, 2)
stEstInv!IND_PROP = ""
stEstInv!COD_PART = ""
stEstInv!TXT_COMPL = ""
stEstInv!COD_CTA = ""
stEstInv!VL_ITEM_IR = FormatNumber(QTDEst, 2) * FormatNumber(VALOR_UNITARIOpass, 2)
stEstInv.Update
jaPassei1 = "S"
End If
If Codpass <> stEstVar!CODIGO Then Exit Do
If stEstVar.EOF = True Then Exit Do
Loop While Codpass = stEstVar!CODIGO
End If
ContarPassadas = ContarPassadas + 1

stEstFix.MoveNext
Me.PriCod = stEstFix!CODIGO
If ContarPassadas = 1700 Then Exit Do
If stEstFix.EOF = True Then Exit Do
Loop While stEstFix.EOF = False
MsgBox "terminou"

End Sub