[Resolvido]Barra de progresso em importação

Olá amigos,
É possível durante a importação haver uma barra de progresso?

Tentei fazer uma barra de progresso e ela não funcionou, ela nem inicia, segue abaixo o base modelo que fiz.

Esta barra contaria com varias mensagens durante o carregamento, tipo os exemplo abaixo:
1 - "Iniciando Processo..."
2 - "Verificando Base de Dados..."
3 - "Iniciando Importação..."
4 - "Importando Base de Dados..."
5 - "Importação do Base de Dados Concluída..."
6 - "Classificando Chamados no Base de Dados..."
7 - "Classificação Concluída..."
8 - "Importação e Classificação Concluída com Sucesso..."

Obrigado pela ajuda e atenção.

Olá Maurício,
Não devemos misturar dúvidas.
O tópico foi dividio.

Ralativamente à questão:
a) o código apresenta erros de compilação, verifique
b) o botão para iniciar a importação (btIniciarBackup) não tem código nenhum de importação, ajuste


Abraço

ahteixeira,

Desculpe a confusão com o tópicos.

Ajustei o código.

O Formulário há 02 botões, um faz a importação e classifica, ou seja, executa a funcionalidade que eu quero.

Já o outro botão seria uma melhoria visual com uma barra de progresso, o código e o mesmo com algumas adicionei de funcionalidades de barra de progresso, porém, a barra não funciona.

Acho que estou errando e alguma coisa.

Obrigado pela atenção e ajuda.

Olá, ainda apresenta erros o exemplo anexo, deve:
ALT+F11 -> DEBUG e Compile
Hoje estou com pouco tempo, e não compreendi bem o seu código.
No entanto onde está a apresentar a "mensagem" , na linah a seguir experimente:
       DoEvents

Abraço

Desculpe, mas fiz e refiz e continua com o mesmo problema e não estou conseguindo resolver.

Olá Maurício,
Como referi o código que postou apresenta erros.
Deveria ter retificado e postado novo exemplo sem erros.
Eu dei a pista DoEvents

Além disso não compreendo porque motivo a importação está a ser efetuada no evento Form_Timer
Vai dar erros, mas vai mostrar o caminho das pedras.

Altere o seu código do exemplo postado por este:

Código:

Private Sub Form_Timer()
'Static strHora As Integer
'Static strMinutos As Integer
'Static strSegundos As Integer
'
'        If Trim(lblTempo.Caption) = "00:00:00" Then
'            strHora = 0
'            strMinutos = 0
'            strSegundos = 0
'        End If
'
'    strSegundos = strSegundos + 1
'
'        If strSegundos = 60 Then
'            strSegundos = 0
'            strMinutos = strMinutos + 1
'        If strMinutos = 60 Then
'            strMinutos = 0
'            strHora = strHora + 1
'        If strHora = 24 Then
'        strHora = 0
'      End If
'    End If
'  End If
'
'    lblTempo.Caption = Format(strHora, "00") & ":" & _
'    Format(strMinutos, "00") & ":" & _
'    Format(strSegundos, "00")
''TEMPO DE INATIVIDADE DO BANCO PARA ENCERRAMENTO SERÁ 10 MINUTOS
'If lblTempo.Caption = "00:00:02" Then
'    DoCmd.Quit acQuitSaveAll
'End If

'---------------------------------------------------------------------------
'Este código se encontra no evento timer para alimentar a barra de progresso
'---------------------------------------------------------------------------
Evento = Evento + 1
        Dim strPathFile As String, strFile As String, strPath As String
        Dim strTable As String
        Dim blnHasFieldNames As Boolean
        blnHasFieldNames = True
        strPath = CurrentProject.Path & "\Importação\"
        strTable = "Tbl_Chamado_SAC"
        strFile = Dir(strPath & "Importação.xlsx")
        Do While Len(strFile) > 0
        strPathFile = strPath & strFile
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
        strTable, strPathFile, blnHasFieldNames
        strFile = Dir()
        Loop

Select Case Evento
    Case 1
        '-------------------------------------------------------------------------
        'Desabilita os botões enquanto a cópia estiver sendo realizada
        'Divide a barra de progresso, que tem um comprimento de 11cm, em 8 pedaços
        '-------------------------------------------------------------------------
        Me!cx1.Visible = True
        Me!btFoco.SetFocus
        Me!btImportação.Enabled = False
        Escala = (12.4 * 567) / 5
        Me!cx1.Width = Escala
    Case 2
        Me!Status.Caption = "Verificando Base de Dados..."
        Me!cx1.Width = Escala * 2
        DoEvents
    Case 3
        Me!Status.Caption = "Importando Base de Dados..."
        Me!cx1.Width = Escala * 3
        DoEvents
    Case 4
        '----------------------------------------------------------------------------
        'Inicia o processo de cópia simples da base de dados para o destino indicado.
        'Aqui a barra de progresso fica parada até a cópia ser concluída
        '----------------------------------------------------------------------------

    Case 5
        '----------------------------------------------
        'Após a conclusão da cópia o código prossegue
        '----------------------------------------------
        Me!Status.Caption = "Importação do Base de Dados Concluída..."
        Me!cx1.Width = Escala * 4
        DoEvents
    Case 6
        DoCmd.SetWarnings False
        DoCmd.OpenQuery ("Consulta_Atualizar_Concatenar_Grupo_e_Tipo_Manifestação"), acViewNormal, acEdit
        DoCmd.SetWarnings True
       
        DoCmd.SetWarnings False
        DoCmd.OpenQuery ("Consulta_Atualizar_Tipo_Manifestação"), acViewNormal, acEdit
        DoCmd.SetWarnings True
    Case 7
        Me!Status.Caption = "Classificando Chamados no Base de Dados..."
        Me!cx1.Width = Escala * 5
        DoEvents
        Me.TimerInterval = 0
        Evento = 0
End Select
sair:
    If Me.TimerInterval = 0 Then DoCmd.Close acDefault
    Exit Sub
trataerro:
    MsgBox err.Number & " - " & err.Description, vbInformation, "Aviso"
    Evento = 0: Screen.MousePointer = 0: Me.TimerInterval = 0
    Resume sair

End Sub

Abraço

ahteixeira,

Desculpe a demora no retorno.

Funcionou demais o código.

Muito obrigado pela ajuda e atenção.

Olá Maurício, obrigado pelo retorno.
O fórum agradece.
Abraço