[Resolvido]Barra de Progresso X Execução de Consultas

Boa tarde,

Solicito mais uma vez, a ajuda dos universitários para o seguinte tema...

Gostaria por gentileza que a barra de progresso (lblProgress) e que o Contador (lblStatus), evoluíssem de acordo com a execução das consultas.

Código:


Private Sub bot_importar_Click()

Dim x As Long
Dim lngWidth As Long
Const conMAX_VALUE As Long = 10000000

Dim EndImport As String


EndImport = cmb_end

lngWidth = Me![lnRef].Width
Me![lblProgress].Visible = True

x = 1

While x <= conMAX_VALUE
 If x Mod 10000 = 0 Then
   DoEvents
     Me![lblStatus].Caption = "Importando...: " & Format$(x / conMAX_VALUE, "Percent")
     Me![lblProgress].Width = ((x / conMAX_VALUE) * lngWidth)
 End If
   x = x + 1
Wend

Me![lblStatus].Caption = "Importação Concluida!"

'Can Reset here if you like

    DoCmd.SetWarnings False
    DoCmd.TransferSpreadsheet acImport, 8, "tab_imp", EndImport, True, ""
    
    DoCmd.RunSQL "UPDATE tab_imp SET tab_imp.TERMINAL = '1', tab_imp.DOCUMENTO_CLIENTE = '1', tab_imp.NOME_CLIENTE = '1', tab_imp.DOC_CLI_FONTE = '1', tab_imp.DES_SER = '1', tab_imp.NOME_SERVICO = '1' WHERE (((tab_imp.TERMINAL)='0'))", -1
    DoCmd.RunSQL "UPDATE tab_imp SET tab_imp.DOC_CLI_FONTE = '2', tab_imp.DOCUMENTO_CLIENTE = '2', tab_imp.NOME_CLIENTE = '2' WHERE (((tab_imp.DOC_CLI_FONTE) is null))", -1
    DoCmd.RunSQL "INSERT INTO tab_uf ( uni_fed ) SELECT tab_imp.UF FROM tab_imp GROUP BY tab_imp.UF", -1
    DoCmd.RunSQL "INSERT INTO tab_for ( dealer, cod_for, cnpj, fan, nom_ent, id_tab_uf )SELECT tab_imp.DEALER, tab_imp.FORNECEDOR, tab_imp.NUM_CGC, tab_imp.FANTASIA, tab_imp.NOME_ENT, tab_uf.id_uf FROM tab_uf INNER JOIN tab_imp ON tab_uf.uni_fed = tab_imp.UF GROUP BY tab_imp.DEALER, tab_imp.FORNECEDOR, tab_imp.NUM_CGC, tab_imp.FANTASIA, tab_imp.NOME_ENT, tab_uf.id_uf", -1
    DoCmd.RunSQL "INSERT INTO tab_cli ( doc_cli ) SELECT tab_imp.DOCUMENTO_CLIENTE FROM tab_imp GROUP BY tab_imp.DOCUMENTO_CLIENTE", -1
    DoCmd.RunSQL "INSERT INTO tab_cli_pro ( id_tab_cli, ter ) SELECT tab_cli.id_cli, tab_imp.TERMINAL FROM (tab_cli LEFT JOIN tab_cli_pro ON tab_cli.id_cli = tab_cli_pro.id_tab_cli) INNER JOIN tab_imp ON tab_cli.doc_cli = tab_imp.DOCUMENTO_CLIENTE GROUP BY tab_cli.id_cli, tab_imp.TERMINAL", -1
    DoCmd.RunSQL "UPDATE tab_cli_pro SET tab_cli_pro.ddd = Left([ter],2);", -1
    DoCmd.RunSQL "INSERT INTO tab_gru_com ( gru_com ) SELECT tab_imp.GRUPO_COMISSAO FROM tab_imp GROUP BY tab_imp.GRUPO_COMISSAO ", -1
    DoCmd.RunSQL "INSERT INTO tab_tip_com ( tab_id_gru_com, tip_com ) SELECT tab_gru_com.id_gru_com, tab_imp.TIPO_COMISSAO FROM tab_gru_com INNER JOIN tab_imp ON tab_gru_com.gru_com = tab_imp.GRUPO_COMISSAO GROUP BY tab_gru_com.id_gru_com, tab_imp.TIPO_COMISSAO ", -1
    DoCmd.RunSQL "INSERT INTO tab_ser ( cod_ser, nom_ser ) SELECT tab_imp.DES_SER, tab_imp.NOME_SERVICO FROM tab_imp GROUP BY tab_imp.DES_SER, tab_imp.NOME_SERVICO ", -1
    DoCmd.RunSQL "INSERT INTO tab_imp_mov ( rel, num_doc_sap, id_tab_for, id_tab_cli_pro, id_tab_tip_com, id_tab_ser, dt_ser, dt_bai, vlr, qtd, com, tip_cal, des_tip_cal, nom_cli, obs, dt_cic, des_pla, sub, det_sub, des_ser_up_dow, vlr_ass_up_dow ) SELECT tab_imp.REL, tab_imp.NR_DOCUMENTO_SAP, tab_for.id_for, tab_cli_pro.id_cli_pro, tab_tip_com.id_tip_com, tab_ser.id_ser, tab_imp.DATA_SERVICO, tab_imp.DATA_BAIXA, tab_imp.VALOR, tab_imp.QUANTIDADE, tab_imp.COMPETENCIA, tab_imp.TIPO_CALCULO, tab_imp.DESC_TIPO_CALCULO, tab_imp.NOME_CLIENTE, tab_imp.OBS, tab_imp.DT_CICLO, tab_imp.DESC_PLANO, tab_imp.SUBSCRICAO, tab_imp.DETALHE_SUBSCRICAO, tab_imp.DESC_SERV_UP_DOWN, tab_imp.VLR_ASSIN_UP_DOWN FROM tab_tip_com INNER JOIN (tab_ser INNER JOIN (tab_cli_pro INNER JOIN (tab_for INNER JOIN tab_imp ON tab_for.cod_for = tab_imp.FORNECEDOR) ON tab_cli_pro.ter = tab_imp.TERMINAL) ON tab_ser.cod_ser = tab_imp.DES_SER) ON tab_tip_com.tip_com = tab_imp.TIPO_COMISSAO", -1
    DoCmd.RunSQL "DELETE tab_imp.UF FROM tab_imp", -1
    DoCmd.RunSQL "UPDATE tab_cli SET tab_cli.doc_cli = Format([doc_cli],'00000000000');", -1
    DoCmd.SetWarnings True
    Beep
    'MsgBox "Importação realizada com sucesso!", vbInformation, "SysCoqueiral"
    'Kill EndImport
    'MsgBox "Arquivo importado excluido com sucesso!", vbInformation, "SysCoqueiral"




End Sub



Olá Dayvid Paixão, o código postado aparentemente foi concebido para operações directamente sob registos (recordset).

Fiz uma pequena adaptação, acho que atende o pretendido.

Código:

Private Sub bot_importar_Click()
Dim cmb_end

Dim x As Long
Dim lngWidth As Long
Const conMAX_VALUE As Long = 14 ' tem 14 operações

Dim EndImport As String


EndImport = cmb_end

lngWidth = Me![lnRef].Width
Me![lblProgress].Visible = True

x = 1

DoCmd.SetWarnings False

    While x <= conMAX_VALUE
    
        Me![lblStatus].Caption = "Importando...: " & Format$(x / conMAX_VALUE, "Percent")
        Me![lblProgress].Width = ((x / conMAX_VALUE) * lngWidth)

        Select Case x
        Case 1
            ' DoCmd.TransferSpreadsheet acImport, 8, "tab_imp", EndImport, True, ""
            DoEvents
        Case 2
            ' DoCmd.RunSQL "UPDATE tab_imp SET tab_imp.TERMINAL = '1', tab_imp.DOCUMENTO_CLIENTE = '1', tab_imp.NOME_CLIENTE = '1', tab_imp.DOC_CLI_FONTE = '1', tab_imp.DES_SER = '1', tab_imp.NOME_SERVICO = '1' WHERE (((tab_imp.TERMINAL)='0'))", -1
            DoEvents
        Case 3
            ' DoCmd.RunSQL "UPDATE tab_imp SET tab_imp.DOC_CLI_FONTE = '2', tab_imp.DOCUMENTO_CLIENTE = '2', tab_imp.NOME_CLIENTE = '2' WHERE (((tab_imp.DOC_CLI_FONTE) is null))", -1
            DoEvents
        Case 4
            ' DoCmd.RunSQL "INSERT INTO tab_uf ( uni_fed ) SELECT tab_imp.UF FROM tab_imp GROUP BY tab_imp.UF", -1
            DoEvents
        Case 5
            ' DoCmd.RunSQL "INSERT INTO tab_for ( dealer, cod_for, cnpj, fan, nom_ent, id_tab_uf )SELECT tab_imp.DEALER, tab_imp.FORNECEDOR, tab_imp.NUM_CGC, tab_imp.FANTASIA, tab_imp.NOME_ENT, tab_uf.id_uf FROM tab_uf INNER JOIN tab_imp ON tab_uf.uni_fed = tab_imp.UF GROUP BY tab_imp.DEALER, tab_imp.FORNECEDOR, tab_imp.NUM_CGC, tab_imp.FANTASIA, tab_imp.NOME_ENT, tab_uf.id_uf", -1
            DoEvents
        Case 6
            ' DoCmd.RunSQL "INSERT INTO tab_cli ( doc_cli ) SELECT tab_imp.DOCUMENTO_CLIENTE FROM tab_imp GROUP BY tab_imp.DOCUMENTO_CLIENTE", -1
            DoEvents
        Case 7
            ' DoCmd.RunSQL "INSERT INTO tab_cli_pro ( id_tab_cli, ter ) SELECT tab_cli.id_cli, tab_imp.TERMINAL FROM (tab_cli LEFT JOIN tab_cli_pro ON tab_cli.id_cli = tab_cli_pro.id_tab_cli) INNER JOIN tab_imp ON tab_cli.doc_cli = tab_imp.DOCUMENTO_CLIENTE GROUP BY tab_cli.id_cli, tab_imp.TERMINAL", -1
            DoEvents
        Case 8
            ' DoCmd.RunSQL "UPDATE tab_cli_pro SET tab_cli_pro.ddd = Left([ter],2);", -1
            DoEvents
        Case 9
            ' DoCmd.RunSQL "INSERT INTO tab_gru_com ( gru_com ) SELECT tab_imp.GRUPO_COMISSAO FROM tab_imp GROUP BY tab_imp.GRUPO_COMISSAO ", -1
            DoEvents
        Case 10
            ' DoCmd.RunSQL "INSERT INTO tab_tip_com ( tab_id_gru_com, tip_com ) SELECT tab_gru_com.id_gru_com, tab_imp.TIPO_COMISSAO FROM tab_gru_com INNER JOIN tab_imp ON tab_gru_com.gru_com = tab_imp.GRUPO_COMISSAO GROUP BY tab_gru_com.id_gru_com, tab_imp.TIPO_COMISSAO ", -1
            DoEvents
        Case 11
            ' DoCmd.RunSQL "INSERT INTO tab_ser ( cod_ser, nom_ser ) SELECT tab_imp.DES_SER, tab_imp.NOME_SERVICO FROM tab_imp GROUP BY tab_imp.DES_SER, tab_imp.NOME_SERVICO ", -1
            DoEvents
        Case 12
            ' DoCmd.RunSQL "INSERT INTO tab_imp_mov ( rel, num_doc_sap, id_tab_for, id_tab_cli_pro, id_tab_tip_com, id_tab_ser, dt_ser, dt_bai, vlr, qtd, com, tip_cal, des_tip_cal, nom_cli, obs, dt_cic, des_pla, sub, det_sub, des_ser_up_dow, vlr_ass_up_dow ) SELECT tab_imp.REL, tab_imp.NR_DOCUMENTO_SAP, tab_for.id_for, tab_cli_pro.id_cli_pro, tab_tip_com.id_tip_com, tab_ser.id_ser, tab_imp.DATA_SERVICO, tab_imp.DATA_BAIXA, tab_imp.VALOR, tab_imp.QUANTIDADE, tab_imp.COMPETENCIA, tab_imp.TIPO_CALCULO, tab_imp.DESC_TIPO_CALCULO, tab_imp.NOME_CLIENTE, tab_imp.OBS, tab_imp.DT_CICLO, tab_imp.DESC_PLANO, tab_imp.SUBSCRICAO, tab_imp.DETALHE_SUBSCRICAO, tab_imp.DESC_SERV_UP_DOWN, tab_imp.VLR_ASSIN_UP_DOWN FROM tab_tip_com INNER JOIN (tab_ser INNER JOIN (tab_cli_pro INNER JOIN (tab_for INNER JOIN tab_imp ON tab_for.cod_for = tab_imp.FORNECEDOR) ON tab_cli_pro.ter = tab_imp.TERMINAL) ON tab_ser.cod_ser = tab_imp.DES_SER) ON tab_tip_com.tip_com = tab_imp.TIPO_COMISSAO", -1
            DoEvents
        Case 13
            ' DoCmd.RunSQL "DELETE tab_imp.UF FROM tab_imp", -1
            DoEvents
        Case 14
            ' DoCmd.RunSQL "UPDATE tab_cli SET tab_cli.doc_cli = Format([doc_cli],'00000000000');", -1
            DoEvents
        End Select
      
       x = x + 1
      
    Wend

    Me![lblStatus].Caption = "Importação Concluida!"
    DoCmd.SetWarnings True

    Beep
    'MsgBox "Importação realizada com sucesso!", vbInformation, "SysCoqueiral"
    'Kill EndImport
    'MsgBox "Arquivo importado excluido com sucesso!", vbInformation, "SysCoqueiral"

End Sub


Abraço

Boa tarde Alvaro Teixeira

Ficou perfeito!!!

Muito obrigado

Parabéns

Olá Dayvid Paixão, obrigado pelo retorno.
Os utilizadores do fórum agradecem.
Abraço

Simples e perfeito! Parabéns!

Olá Janette, obrigado pelo retorno.
Com o MaximoAccess é sempre aprender
Abraço

Olá, vendo o código poderia ter ficado melhor.

Está a repetir o DoEvents nas 14 operações do select case.

Se colocarmos DoEvents na linha seguinte ao End Select, podemos retirar o DoEvents das outras 14 linhas.

Não testado, mas fica a dica.
Como diz o nosso colega JPaulo, "existe mil maneiras de fazer nestum"
Abraço