MaximoAccess

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

Obrigado

Administração do MaximoAccess

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

    [Resolvido]Adicionar Primary Key em tabela Ordenada a partir de um campo

    Compartilhe

    Fernando.Naque
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 7
    Registrado : 15/06/2011

    [Resolvido]Adicionar Primary Key em tabela Ordenada a partir de um campo

    Mensagem  Fernando.Naque em Seg 12 Fev 2018, 11:25

    Bom dia!

    Utilizo um código para adicionar um Primary Key em uma tabela importada via código. E esta funcionando a adição.
    Mas preciso que a primary key fosse adicionada em ordem crescente seguindo o campo Parcela. E isso não esta acontecendo.

    Public Function AbriRC()

    ' Requer referencia a Microsoft Office 11 Object Library
       On Error GoTo PROC_ERR
       
       Dim fd As FileDialog
       Set fd = Application.FileDialog(msoFileDialogFilePicker)
       
       fd.Title = "Selecione o arquivo base de Protocolo"
       fd.Filters.Add "Base GIS", "*.dbf, *.xlsx", 1

       fd.Show
       
       If (fd.SelectedItems.Count > 0) Then
           '------inicio importação excel para sincronização
           Dim strPathFile As String, strFile As String, strPath As String
           Dim strTable As String
           Dim FileName As String
           Dim Dir1 As String
           Dim blnHasFieldNames As Boolean
           Dim db As DAO.Database
           Dim tbl As DAO.TableDef
           Dim cpo As DAO.Field
           Dim nbTypeFile As Integer
           blnHasFieldNames = True
           Dir1 = Left(fd.SelectedItems(1), (Len(fd.SelectedItems(1)) - Len(strFile)))
           strPathFile = fd.SelectedItems(1)
           strPath = CurrentProject.Path
           strTable = "FromDBF"
           strFile = Dir(fd.SelectedItems(1))
           nbTypeFile = InStr(1, Right(strFile, 5), ".") 'Tipo de Arquivos (1=DBF 2=Excel)
                       
           'MsgBox Left(fd.SelectedItems(1), (Len(fd.SelectedItems(1)) - Len(strFile) - 1)) & " / " & strFile ' Teste
               
                 
           'apaga temporarios
           'DoCmd.RunSQL "Delete * from [FromDBF]"
            DoCmd.DeleteObject acTable, strTable

           
           'On Error Resume Next
                   
           'importa para tabela local temporária
           'Formato XLSX ACRESCETAR A TABELA EXISTENTE
           'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTable, strPathFile, blnHasFieldNames
           
           
                   
           'Formato DBF
           DoCmd.TransferDatabase TransferType:=acImport, DatabaseType:="dBASE III", DatabaseName:=Left(fd.SelectedItems(1), (Len(fd.SelectedItems(1)) - Len(strFile) - 1)), ObjectType:=acTable, Source:=strFile, Destination:=strTable
           On Error GoTo PROC_ERR
           'Ordena campos na talela
           DoCmd.OpenTable strTable
           DoCmd.SetOrderBy "Parcela ASC"
           DoCmd.Save acTable, strTable
           DoCmd.Close acTable, strTable
           CurrentDb.Execute ("Alter Table FromDBF ADD COLUMN cd_id2 AutoIncrement;")
           
                             
           'Formato CSV
           
           'DoCmd.TransferText TransferType:=acImportDelim, _
                   TableName:="strTable", hasfieldnames:=True, FileName:=strPathFile
           'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, strTable, strPathFile, blnHasFieldNames
           
           'sql verifica existentes e marca com não novo
           'DoCmd.OpenQuery "xls01marcaExistentes", acViewNormal, acEdit
           'sql atualiza existentes
           'DoCmd.OpenQuery "xls02AtualizaExistentes", acViewNormal, acEdit
           'sql lança novos no ficheiro funcionarios
           'DoCmd.OpenQuery "xls03LancaNovos", acViewNormal, acEdit
           
           MsgBox "Operação concluída.", vbInformation, ""
           
           'apaga temporarios
           'DoCmd.RunSQL "Delete * from [Dados Coletor]"
           
       Else
           MsgBox "Não foi escolhido nenhum ficheiro", vbInformation, ""
       End If
       
    PROC_EXIT:
       Exit Function
       
    PROC_ERR:
       DoCmd.Hourglass False
       If Err.Number = 3011 Then
          LocalXML = ""
          MsgBox ("Ficheiro inválido. Verifique se no nome do arquivo existe espaços em branco, algum caractere especial (- / _ & @) ou se o formato do arquivo está correto.")
          'Cria uma tabela
          Set db = CurrentDb
          Set tbl = db.CreateTableDef("FromDBF")
          Set cpo = tbl.CreateField("cData", dbDate)
          tbl.Fields.Append cpo
          db.TableDefs.Append tbl
          db.TableDefs.Refresh
             
       Else
           MsgBox Err.Description
       End If
       Resume PROC_EXIT

    End Function


    Última edição por Fernando.Naque em Qua 14 Fev 2018, 01:14, editado 1 vez(es)
    avatar
    Noobezinho
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3103
    Registrado : 29/06/2012

    Re: [Resolvido]Adicionar Primary Key em tabela Ordenada a partir de um campo

    Mensagem  Noobezinho em Seg 12 Fev 2018, 13:03

    Fernando

    Uma ideia que me ocorreu.

    Como já sabe adicionar a primary key em uma tabela importada,


    sugiro que crie uma consulta de criação de tabela, com o campo parcela ordenado.

    então..

    E só aplicar a adição da primary key

    Que tal?


    .................................................................................
    Noobezinho

    * A solução funcionou?  [Você precisa estar registrado e conectado para ver esta imagem.] 
    Agradeça e feche o tópico clicando no botão Resolvido
    Se não sabe como, veja [Você precisa estar registrado e conectado para ver este link.].

    Como anexar imagem no teu post do fórum : [Você precisa estar registrado e conectado para ver este link.]

    * Criar arquivos.zip com o Winrar - veja [Você precisa estar registrado e conectado para ver este link.].

    Atualmente estou verificando se ajudamos alguém e não retornou.
    Se não deu retorno, não ajudo novamente .

    Fernando.Naque
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 7
    Registrado : 15/06/2011

    Re: [Resolvido]Adicionar Primary Key em tabela Ordenada a partir de um campo

    Mensagem  Fernando.Naque em Qua 14 Fev 2018, 00:52

    Noobezinho, Muito obrigado!


    Funcionou perfeitamente e me ajudou em uma outra tarefa. cheers Very Happy bounce

    Podemos encerrar o tópico. Vou acrescentar abaixo o código para futuras consultas:

    ------------------------------------------------------------------------------------------------
    Código:

    Public Function AbriRC()

    ' Requer referencia a Microsoft Office 11 Object Library
       On Error GoTo PROC_ERR
       
       Dim fd As FileDialog
       Set fd = Application.FileDialog(msoFileDialogFilePicker)
       
       fd.Title = "Selecione o arquivo base de Protocolo"
       fd.Filters.Add "Base GIS", "*.dbf, *.xlsx", 1

       fd.Show
       
       If (fd.SelectedItems.Count > 0) Then
           '------inicio importação excel para sincronização
           Dim strPathFile As String, strFile As String, strPath As String
           Dim strTable As String
           Dim FileName As String
           Dim Dir1 As String
           'Dim blnHasFieldNames As Boolean
           Dim db As DAO.Database
           Dim tbl As DAO.TableDef
           Dim cpo As DAO.Field
           Dim nbTypeFile As Integer
           'blnHasFieldNames = True
           Dir1 = Left(fd.SelectedItems(1), (Len(fd.SelectedItems(1)) - Len(strFile)))
           strPathFile = fd.SelectedItems(1)
           strPath = CurrentProject.Path
           strTable = "FromDBF"
           strFile = Dir(fd.SelectedItems(1))
           nbTypeFile = InStr(1, Right(strFile, 5), ".") 'Tipo de Arquivos (1=DBF 2=Excel)
                       
           'MsgBox Left(fd.SelectedItems(1), (Len(fd.SelectedItems(1)) - Len(strFile) - 1)) & " / " & strFile ' Teste
               
                 
           'apaga temporarios
           'DoCmd.RunSQL "Delete * from [FromDBF]"
            DoCmd.DeleteObject acTable, strTable

           
           'On Error Resume Next
                   
           'importa para tabela local temporária
           'Formato XLSX ACRESCETAR A TABELA EXISTENTE
           'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTable, strPathFile, blnHasFieldNames
           
           
                   
           'Formato DBF Importando dados
           DoCmd.TransferDatabase TransferType:=acImport, DatabaseType:="dBASE III", DatabaseName:=Left(fd.SelectedItems(1), (Len(fd.SelectedItems(1)) - Len(strFile) - 1)), ObjectType:=acTable, Source:=strFile, Destination:=strTable
           
           'Executando Consultas Criar Tabela e inserindo as chaves primárias
    [color=#0033ff][b]        DoCmd.SetWarnings (WarbingsOff)
             DoCmd.OpenQuery "CriarTalhao", acViewNormal, acEdit
            CurrentDb.Execute ("Alter Table BaseTalhao ADD COLUMN cd_id1 AutoIncrement;")
            DoCmd.OpenQuery "CriarParcelas", acViewNormal, acEdit
            CurrentDb.Execute ("Alter Table BaseParcelas ADD COLUMN cd_id2 AutoIncrement;")
            DoCmd.SetWarnings (WarbingsOn)[/b][/color]
               
           
                     
           'Formato CSV
           
           'DoCmd.TransferText TransferType:=acImportDelim, _
                   TableName:="strTable", hasfieldnames:=True, FileName:=strPathFile
           'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, strTable, strPathFile, blnHasFieldNames
           
           'sql verifica existentes e marca com não novo
           'DoCmd.OpenQuery "xls01marcaExistentes", acViewNormal, acEdit
           'sql atualiza existentes
           'DoCmd.OpenQuery "xls02AtualizaExistentes", acViewNormal, acEdit
           'sql lança novos no ficheiro funcionarios
           'DoCmd.OpenQuery "xls03LancaNovos", acViewNormal, acEdit
           
           MsgBox "Operação concluída.", vbInformation, ""
           
           
           'apaga temporarios
           'DoCmd.RunSQL "Delete * from [Dados Coletor]"
           
       Else
           MsgBox "Não foi escolhido nenhum ficheiro", vbInformation, ""
       End If
       
    PROC_EXIT:
       Exit Function
       
    PROC_ERR:
       DoCmd.Hourglass False
       If Err.Number = 3011 Then
          LocalXML = ""
          MsgBox ("Ficheiro inválido. Verifique se no nome do arquivo existe espaços em branco, algum caractere especial (- / _ & @) ou se o formato do arquivo está correto.")
          'Cria uma tabela
          Set db = CurrentDb
          Set tbl = db.CreateTableDef("FromDBF")
          Set cpo = tbl.CreateField("cData", dbDate)
          tbl.Fields.Append cpo
          db.TableDefs.Append tbl
          db.TableDefs.Refresh
             
       Else
           MsgBox Err.Description
       End If
       Resume PROC_EXIT
       

    End Function
    avatar
    Noobezinho
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3103
    Registrado : 29/06/2012

    Re: [Resolvido]Adicionar Primary Key em tabela Ordenada a partir de um campo

    Mensagem  Noobezinho em Qua 14 Fev 2018, 08:50

    Fernando

    Que bom que pude ajudar!

    Valeu pelo retorno!

    Boa sorte!


    .................................................................................
    Noobezinho

    * A solução funcionou?  [Você precisa estar registrado e conectado para ver esta imagem.] 
    Agradeça e feche o tópico clicando no botão Resolvido
    Se não sabe como, veja [Você precisa estar registrado e conectado para ver este link.].

    Como anexar imagem no teu post do fórum : [Você precisa estar registrado e conectado para ver este link.]

    * Criar arquivos.zip com o Winrar - veja [Você precisa estar registrado e conectado para ver este link.].

    Atualmente estou verificando se ajudamos alguém e não retornou.
    Se não deu retorno, não ajudo novamente .

      Data/hora atual: Sab 17 Fev 2018, 23:39