MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

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


2 participantes

    [Resolvido]Várias sheets renomeando e definindo range

    janettepires
    janettepires
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 126
    Registrado : 14/03/2013

    [Resolvido]Várias sheets renomeando e definindo range Empty [Resolvido]Várias sheets renomeando e definindo range

    Mensagem  janettepires 9/5/2017, 14:07

    BOM DIA!

    Preciso importar todos os sheets de uma planilha como tabelas no Access, teria como renomear as tabelas enquanto importa e definir o range?

    Vi esse código do JP, mas não atende, pois em determinadas sheets ele não interpreta alguns dados e trava.


    Private Sub SeuBotao_Click()
    Dim appExcel As Excel.Application
    Dim wb As Excel.Workbook
    Dim sh As Excel.Worksheet
    Dim strValue As String
    Set appExcel = CreateObject("Excel.Application")
    Set wb = appExcel.Workbooks.Open("C:\temp.xls") 'nome do seu excel e seu diretorio
    For Each sh In wb.Sheets
    Debug.Print sh.Name
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tbl_" & sh.Name, "C:\temp.xls", True, sh.Name & "!"
    Next
    wb.Close
    appExcel.Quit
    On Error GoTo 0
    Exit Sub
    End Sub
    JPaulo
    JPaulo
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 11026
    Registrado : 04/11/2009

    [Resolvido]Várias sheets renomeando e definindo range Empty Re: [Resolvido]Várias sheets renomeando e definindo range

    Mensagem  JPaulo 9/5/2017, 14:32

    Veja outros, no link da minha assinatura 102 códigos VBA gratuitos,

    Código = ImportarExcelParaAccess


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    [Resolvido]Várias sheets renomeando e definindo range Folder_announce_new Utilize o Sistema de Busca do Fórum...
    [Resolvido]Várias sheets renomeando e definindo range Folder_announce_new 102 Códigos VBA Gratuitos...
    [Resolvido]Várias sheets renomeando e definindo range Folder_announce_new Instruções SQL como utilizar...
    janettepires
    janettepires
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 126
    Registrado : 14/03/2013

    [Resolvido]Várias sheets renomeando e definindo range Empty Re: [Resolvido]Várias sheets renomeando e definindo range

    Mensagem  janettepires 9/5/2017, 16:28

    Encontrei uma função que faz exatamente o que eu preciso.

    Public Function ImportaDados(Path As String)


    On Error GoTo Err_handler

    Dim xlApp As Excel.Application
    Dim xlWb As Excel.Workbook


    'Set ww = xlWb.Sheets.Item(Z)
    Set xlApp = New Excel.Application
    Set xlWb = xlApp.Workbooks.Open(Path)


    For Each ws In xlWb.Worksheets
    For I = 1 To 300 'Linha Inicial e Final
    If ws.Range("A" & I).Value > 0 Then

    strSQL = "Insert Into TabelaDados (Campo1,Campo2,Campo3,Campo4,Campo5,Campo6,Campo7,Campo8,Campo9,Campo10,Campo11,Campo12,campo13)"
    strSQL = strSQL & " Values ('" & ws.Range("A" & I).Value & "','" & ws.Range("B" & I).Value & "','" & ws.Range("C" & I).Value & "','" & ws.Range("D" & I).Value & "','" & ws.Range("E" & I).Value & "','" & ws.Range("F" & I).Value & "','" & ws.Range("G" & I).Value & "','" & ws.Range("H" & I).Value & "','" & ws.Range("I" & I).Value & "','" & ws.Range("J" & I).Value & "','" & ws.Range("K" & I).Value & "','" & ws.Range("L" & I).Value & "','" & ws.Range("M" & I).Value & ws.Name & " ')"
    ' strSQL = strSQL & " Names ('" & ws.Range("M" & I).Name & "')"

    'ws.Range("M" & I).Value = ws.Name

    DoCmd.SetWarnings False
    DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True

    Else
    Exit For
    End If
    Next



    'MsgBox "Importada Planilha: " & ws.Name

    Next ws


    MsgBox "Dados importados com sucesso.", vbInformation, "Mensagem"


    xlApp.Close
    ws.Close

    'Set xlApp = Nothing
    Set xlWb = Nothing

    Exit Function

    Err_handler:
    If Err.Number > 0 Then
    MsgBox "Ocorreu um erro. Detalhes do erro: " & vbCrLf & vbCrLf & Err.Description, vbCritical, "Mensagem"
    Err.Clear
    Exit Function
    End If
    End Function

    Conteúdo patrocinado


    [Resolvido]Várias sheets renomeando e definindo range Empty Re: [Resolvido]Várias sheets renomeando e definindo range

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 22/11/2024, 04:01