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]Achar posição da sheet do excel VBA

    gabrielpn06
    gabrielpn06
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 180
    Registrado : 17/01/2017

    [Resolvido]Achar posição da sheet do excel VBA Empty [Resolvido]Achar posição da sheet do excel VBA

    Mensagem  gabrielpn06 em 15/4/2020, 22:02

    Boa tarde amigos,

    Tenho uma rotina que faz a importação de todos os arquivos de uma pasta na rede por meio de Recordset.

    A rotina funciona muito bem desde que não seja alterado o nome da sheet do excel a qual desejo importar.

    Podem me ajudar dizendo como faço para abrir a sheet pela posição e não pelo seu nome?

    Desde já agradeço pela ajuda!

    Abaixo o trecho que faz a abertura da sheet:

    Código:
      Set dbExcel = OpenDatabase(strPathFile, False, True, "Excel 8.0; HDR=NO; IMEX=1;")
                Set rsExcel = dbExcel.OpenRecordset("Planilha1$")


    Abaixo o código na integra:

    Código:

    Public Function ImpNovosCasos()

     CurrentDb.Execute "DELETE * FROM tbProducao"

    'IMPORT
     blnHasFieldNames = True
     strPath = (CurrentProject.Path & "\Input\")    'Caminho
     strTable = "tbProducao"                        'nome da tabela no seu banco
     strFile = Dir(strPath & "*.xlsx")              'nome do excel a ser importado

        Do While Len(strFile) > 0
        strPathFile = strPath & strFile

        'INÍCIO
            Dim dbLocal As DAO.Database
            Dim myRec As DAO.Recordset
            Dim dbExcel As DAO.Database
            Dim rsExcel As DAO.Recordset
            Dim rsTable As DAO.Recordset
            Dim Planilha As String

            Set myRec = CurrentDb.OpenRecordset("tbProducao")
            Set dbLocal = CurrentDb

                Planilha = strFile

                Set dbExcel = OpenDatabase(strPathFile, False, True, "Excel 8.0; HDR=NO; IMEX=1;")
                Set rsExcel = dbExcel.OpenRecordset("Planilha1$")

                rsExcel.MoveNext

                Do While Not rsExcel.EOF
                    myRec.AddNew

                        coluna = "DATA_ENVIO"
                        myRec.Fields(coluna) = Trim(rsExcel.Fields(1))

                        coluna = "ESCRITORIO"
                        myRec.Fields(coluna) = Trim(rsExcel.Fields(2))

                        coluna = "TIPO"
                        myRec.Fields(coluna) = Trim(rsExcel.Fields(3))

                        coluna = "N_PROCESSO"
                        myRec.Fields(coluna) = Trim(rsExcel.Fields(4))

                        coluna = "AUTOR"
                        myRec.Fields(coluna) = Trim(rsExcel.Fields(5))

                        coluna = "COMARCA"
                        myRec.Fields(coluna) = Trim(rsExcel.Fields(6))

                        coluna = "UF"
                        myRec.Fields(coluna) = Trim(rsExcel.Fields(7))

                        coluna = "VALOR_RESGATADO"
                        myRec.Fields(coluna) = Trim(rsExcel.Fields(8))

                        coluna = "IR"
                        myRec.Fields(coluna) = Trim(rsExcel.Fields(10))

                        coluna = "VALOR_TARIFA"
                        myRec.Fields(coluna) = Trim(rsExcel.Fields(11))

                        coluna = "N_ALVARA"
                        myRec.Fields(coluna) = Trim(rsExcel.Fields(12))

                        coluna = "DATA_ALVARA"
                        myRec.Fields(coluna) = Trim(rsExcel.Fields(13))

                        coluna = "N_CONTA"
                        myRec.Fields(coluna) = Trim(rsExcel.Fields(14))
     
                        coluna = "ATENCAO"
                        myRec.Fields(coluna) = "-"

                    myRec.Update
                    rsExcel.MoveNext
                Loop

                rsExcel.Close
                Set rsExcel = Nothing
                dbExcel.Close
                Set dbExcel = Nothing

            dbLocal.Close
            Set dbLocal = Nothing

        'FIM

        strFile = Dir()
        Loop
     MSGBOX "FIM!"
    End Function
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7677
    Registrado : 05/11/2009

    [Resolvido]Achar posição da sheet do excel VBA Empty Re: [Resolvido]Achar posição da sheet do excel VBA

    Mensagem  Alexandre Neves em 16/4/2020, 16:51

    Boa tarde

    Pelo método opendatabase julgo que não consegue escolher a folha a ser importada
    Em vez disso, instancie o Excel e carregue a folha que quiser do género

    Set meuExcel = CreateObject("Excel.Application")
    set Folha=meuexcel.Workbooks.Open nomeficheiro
    do
    Linha=linha+1
    if linha=100 then exit do
    debug.print ObjectoExcel.Sheets(1).Cells(i,1)'pelo número da folha
    debug.print ObjectoExcel.Sheets("Folha1").Cells(i,1)'pelo nome da folha
    loop


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo
    gabrielpn06
    gabrielpn06
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 180
    Registrado : 17/01/2017

    [Resolvido]Achar posição da sheet do excel VBA Empty Re: [Resolvido]Achar posição da sheet do excel VBA

    Mensagem  gabrielpn06 em 16/4/2020, 21:07

    Boa tarde mestre,

    Funcionou perfeitamente.
    Muito obrigado pela ajuda!

    Abaixo o código de como ficou caso alguém precise:

    Código:
    Public Function ImpTESTE()

     CurrentDb.Execute "DELETE * FROM tbProducao"

    'IMPORT
     blnHasFieldNames = True
     strPath = (CurrentProject.Path & "\Input\")    'Caminho
     strTable = "tbProducao"                        'nome da tabela no seu banco
     strFile = Dir(strPath & "*.xlsx")              'nome do excel a ser importado

        Do While Len(strFile) > 0
        strPathFile = strPath & strFile

        'INÍCIO
            Dim dbLocal As DAO.Database
            Dim rsTable As DAO.Recordset

            Set myRec = CurrentDb.OpenRecordset("tbProducao")
            Set dbLocal = CurrentDb
           
            Set appExcel = CreateObject("Excel.Application")
            Set myExcel = appExcel.Workbooks.Open(strPathFile)
                linha = 2
               
                Do While Len(Trim(myExcel.Sheets(1).Cells(linha, 2))) = 10
                   
                    myRec.AddNew
                        coluna = "DATA_ENVIO"
                        myRec.Fields(coluna) = Trim(myExcel.Sheets(1).Cells(linha, 2))

                        coluna = "ESCRITORIO"
                        myRec.Fields(coluna) = Trim(myExcel.Sheets(1).Cells(linha, 3))

                        coluna = "TIPO"
                        myRec.Fields(coluna) = Trim(myExcel.Sheets(1).Cells(linha, 4))

                        coluna = "N_PROCESSO"
                        myRec.Fields(coluna) = Trim(myExcel.Sheets(1).Cells(linha, 5))

                        coluna = "AUTOR"
                        myRec.Fields(coluna) = Trim(myExcel.Sheets(1).Cells(linha, 6))

                        coluna = "COMARCA"
                        myRec.Fields(coluna) = Trim(myExcel.Sheets(1).Cells(linha, 7))

                        coluna = "UF"
                        myRec.Fields(coluna) = Trim(myExcel.Sheets(1).Cells(linha, 8))

                        coluna = "VALOR_RESGATADO"
                        myRec.Fields(coluna) = Trim(myExcel.Sheets(1).Cells(linha, 9))

                        coluna = "IR"
                        myRec.Fields(coluna) = Trim(myExcel.Sheets(1).Cells(linha, 10))

                        coluna = "VALOR_TARIFA"
                        myRec.Fields(coluna) = Trim(myExcel.Sheets(1).Cells(linha, 11))

                        coluna = "N_ALVARA"
                        myRec.Fields(coluna) = Trim(myExcel.Sheets(1).Cells(linha, 12))

                        coluna = "DATA_ALVARA"
                        myRec.Fields(coluna) = Trim(myExcel.Sheets(1).Cells(linha, 13))

                        coluna = "N_CONTA"
                        myRec.Fields(coluna) = Trim(myExcel.Sheets(1).Cells(linha, 14))

                        coluna = "ATENCAO"
                        myRec.Fields(coluna) = Trim(myExcel.Sheets(1).Cells(linha, 15))
                    myRec.Update
               
                    linha = linha + 1
               
                Loop

            dbLocal.Close
            Set dbLocal = Nothing

        'FIM

        strFile = Dir()
        Loop
    msgbox "FIM"

    End Function

      Data/hora atual: 15/8/2020, 05:18