MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Verificar existência do ficheiro Excel a importar

    avatar
    catyl
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 29
    Registrado : 24/04/2019

    [Resolvido]Verificar existência do ficheiro Excel a importar Empty [Resolvido]Verificar existência do ficheiro Excel a importar

    Mensagem  catyl em 28/1/2020, 11:42

    boa tarde,
    solicito a vossa ajuda na seguinte situação:
    encontrei aqui o código abaixo que importar dados para o excel funciona perfeitamente mas gostaria que antes de importar verificasse se o ficheiro excel à importar existe.
    é possível? já tentei não consegui, segue a bd em anexo. desde já agradeço

    Código:
    Private Sub btbimp_Click()
    On Error GoTo f

       Dim rst As DAO.Recordset, LivroExcel, Linha As Integer
       'criar ligação com excel
       Set LivroExcel = CreateObject("Excel.Application")
       LivroExcel.Workbooks.Open CurrentProject.Path & "\Controlo_Valor.xlsx"
       'criar recordet
       Set rst = CurrentDb.OpenRecordset("SELECT DataValor, Valor FROM tbl_Valor")
       'cria novo registo na tabela e importa do excel
       Linha = 2
       Do While LivroExcel.Cells(Linha, 1)
       rst.AddNew
       rst("DataValor") = LivroExcel.Cells(Linha, 1)
       rst("Valor") = LivroExcel.Cells(Linha, 2)
       rst.Update
       Linha = Linha + 1
     
       Loop
           MsgBox "Importação efectuado com sucesso!", vbInformation, ""

       'fechaexcel
       
       LivroExcel.ActiveWorkbook.Close SaveChanges:=False
       Set LivroExcel = Nothing
       
       'fecha rst
       Set rst = Nothing
    f:
    Call TrataErroF
    End Sub
    Anexos
    [Resolvido]Verificar existência do ficheiro Excel a importar Attachmentteste.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (55 Kb) Baixado 5 vez(es)
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6816
    Registrado : 15/03/2013

    [Resolvido]Verificar existência do ficheiro Excel a importar Empty Re: [Resolvido]Verificar existência do ficheiro Excel a importar

    Mensagem  ahteixeira em 28/1/2020, 14:50

    Olá Caty,

    Coloque o código abaixo na linha seguinte onde tem On Error GoTo f:

    Código:
    If Dir(CurrentProject.Path & "\Controlo_Valor.xlsx") = "" Then
        MsgBox "Não existe o ficheiro, a operação vai ser cancelada.", vbCritical, ""
        Exit Sub
    End If

    Abraço
    avatar
    catyl
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 29
    Registrado : 24/04/2019

    [Resolvido]Verificar existência do ficheiro Excel a importar Empty Re: [Resolvido]Verificar existência do ficheiro Excel a importar

    Mensagem  catyl em 28/1/2020, 17:15

    muito obrigado mestre ahteixeira está a funcionar perfeitamente!!!
    continuei a pesquisar aqui e consegui adaptar o código abaixo também funciona.
    obrigado mais uma vez tempo tempo dispensado e mais um aprendizado


    Dim rst As DAO.Recordset, LivroExcel, Linha As Integer
    Dim fso
    Dim file As String
    file = CurrentProject.Path & "\Controlo_Valor.xlsx"
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FileExists(file) Then
    MsgBox (" não encontrado."), vbInformation, "Não Encontrado"
    Else
    'criar ligação com excel
    Set LivroExcel = CreateObject("Excel.Application")
    LivroExcel.Workbooks.Open CurrentProject.Path & "\Controlo_Valor.xlsx"

    'criar recordet
    Set rst = CurrentDb.OpenRecordset("SELECT DataValor, Valor FROM tbl_Valor")
    'cria novo registo na tabela e importa do excel
    Linha = 2
    Do While LivroExcel.Cells(Linha, 1)
    rst.AddNew
    rst("DataValor") = LivroExcel.Cells(Linha, 1)
    rst("Valor") = LivroExcel.Cells(Linha, 2)
    rst.Update
    Linha = Linha + 1

    Loop
    MsgBox "Importação efectuado com sucesso!", vbInformation, ""

    'fechaexcel

    LivroExcel.ActiveWorkbook.Close SaveChanges:=False
    Set LivroExcel = Nothing

    'fecha rst
    Set rst = Nothing

    End If

      Data/hora atual: 5/8/2020, 20:41