Prezados,
vejam se minha duvida é pertinente e se tem como contornar esta situação:
Eu uso este código para importar planilhas em Excel para o Access, porém, sempre que recebo o novo arquivo excel para importar eu preciso modificar o cabeçalho do xlsx e deixar o mesmo igual está na minha tabela.
Tem como ignorar as 4 primeiras linhas do arquivo xlsx no momento da importação?
Seria basicamente como se o arquivo não tivesse cabeçalho.
Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String
Dim CaminhoDoFicheiro As String
Dim JanelaDeProcura As Office.FileDialog
Dim MeusFiltros As Office.FileDialogFilter
Dim blnHasFieldNames As Boolean
'On Error Resume Next
If Forms!logon!nivel = "FINANCEIRO" Or Forms!logon!cboSetor = "ADMINISTRADOR" Then
blnHasFieldNames = True
' strArquivo = Mid(Arquivo, InStrRev(Arquivo, "\") + 1)
'---------------------------------------------------------------------------------
'Aplica na variável o nome do caminho que será gravado o arquivo + o nome do mesmo
'---------------------------------------------------------------------------------
' NovoCaminho = CurrentProject.Path & "\Arquivos Importados\" & strArquivo
strPath = CurrentProject.Path & "\Demonstrativo de Pagamento\" & InitialFileName ' drive onde se situa o seu documento excel
strTable = "RecebidoMDLMODELO" 'nome da tabela no seu banco que recebera os dados
Set JanelaDeProcura = Application.FileDialog(msoFileDialogFilePicker)
With JanelaDeProcura
.Title = "Selecione o arquivo"
.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx"
.FilterIndex = 2
.ButtonName = "Selecione"
.InitialView = msoFileDialogViewDetails
.InitialFileName = CurrentProject.Path & "\Demonstrativo de Pagamento\" & InitialFileName
If .Show = -1 Then
CaminhoDoFicheiro = CStr(JanelaDeProcura.SelectedItems.Item(1))
Else
Exit Sub
End If
Debug.Print Mid([CaminhoDoFicheiro], InStrRev([CaminhoDoFicheiro], "\") + 1)
CaminhoDoFicheiro = Mid([CaminhoDoFicheiro], InStrRev([CaminhoDoFicheiro], "\") + 1)
End With
strFile = Dir(strPath & CaminhoDoFicheiro) 'preciso que aqui tenha uma opção para procurar o arquivo, com "*.xls" ele carrega todos, e eu quero que ele defina o selecionado.
Do While Len(strFile) > 0
strPathFile = strPath & strFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strTable, strPathFile, blnHasFieldNames
strFile = Dir()
Loop
'----------------------
'Exclui simbolos da tabela Recebido
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM RecebidoMDLMODELO")
While (Not rs.EOF)
On Error Resume Next
rs.Edit
rs("CdGuia") = Replace(rs("CdGuia"), "-", "")
rs("CdUsuario") = Replace(rs("CdUsuario"), ".", "")
rs("QtServico") = Replace(rs("QtServico"), "000", "")
rs.Update
rs.MoveNext
Wend
rs.Close
'Insert de Servicos Bloqueados
DoCmd.OpenQuery "QueryInsertServicosBloqueados"
'Exclui linha que tem a descrição: Servicos Bloqueados
DoCmd.OpenQuery "QueryExclServicosBloqueados"
'Seta registros na tabela Recebido
CurrentDb.Execute "INSERT INTO Recebido ( senhaAutorizacao, numeroCarteira, nomeBeneficiario, codigo, descricao, dataHoraInternacao, quantidade, valorUnitario, valorTotal )" & vbCrLf & _
"SELECT RecebidoMDLMODELO.CdGuia, RecebidoMDLMODELO.CdUsuario, RecebidoMDLMODELO.NoUsuario2, RecebidoMDLMODELO.CdServico, RecebidoMDLMODELO.NoServico, RecebidoMDLMODELO.strDtAtendimento, Sum(RecebidoMDLMODELO.QtServico) AS SomaQtServico" & vbCrLf & _
",Sum(RecebidoMDLMODELO.VlReferencia) AS SomaDeVlReferencia, Sum(RecebidoMDLMODELO.VlPago_Em_Moeda) AS SomaDeVlPago_Em_Moeda" & vbCrLf & _
"FROM RecebidoMDLMODELO" & vbCrLf & _
"GROUP BY RecebidoMDLMODELO.CdGuia, RecebidoMDLMODELO.CdUsuario, RecebidoMDLMODELO.NoUsuario2, RecebidoMDLMODELO.CdServico, RecebidoMDLMODELO.NoServico, RecebidoMDLMODELO.strDtAtendimento;"
'Exclui linha que tem a nome: Nulo em Recebido
DoCmd.OpenQuery "QueryExcelRecebidosNull"
CurrentDb.Execute "DELETE * FROM RecebidoMDLMODELO"
MsgBox "Demonstrativo de pagamento importado com sucesso!", vbInformation, "Importar Registros"
DoCmd.OpenForm "frmDtCredito"
Else
MsgBox "USUÁRIO ATUAL NÃO TEM PERMISSÃO PARA ALTERAR AS CONFIGURAÇÕES DE ACESSO!", vbCritical, "Aviso"
End If
vejam se minha duvida é pertinente e se tem como contornar esta situação:
Eu uso este código para importar planilhas em Excel para o Access, porém, sempre que recebo o novo arquivo excel para importar eu preciso modificar o cabeçalho do xlsx e deixar o mesmo igual está na minha tabela.
Tem como ignorar as 4 primeiras linhas do arquivo xlsx no momento da importação?
Seria basicamente como se o arquivo não tivesse cabeçalho.
Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String
Dim CaminhoDoFicheiro As String
Dim JanelaDeProcura As Office.FileDialog
Dim MeusFiltros As Office.FileDialogFilter
Dim blnHasFieldNames As Boolean
'On Error Resume Next
If Forms!logon!nivel = "FINANCEIRO" Or Forms!logon!cboSetor = "ADMINISTRADOR" Then
blnHasFieldNames = True
' strArquivo = Mid(Arquivo, InStrRev(Arquivo, "\") + 1)
'---------------------------------------------------------------------------------
'Aplica na variável o nome do caminho que será gravado o arquivo + o nome do mesmo
'---------------------------------------------------------------------------------
' NovoCaminho = CurrentProject.Path & "\Arquivos Importados\" & strArquivo
strPath = CurrentProject.Path & "\Demonstrativo de Pagamento\" & InitialFileName ' drive onde se situa o seu documento excel
strTable = "RecebidoMDLMODELO" 'nome da tabela no seu banco que recebera os dados
Set JanelaDeProcura = Application.FileDialog(msoFileDialogFilePicker)
With JanelaDeProcura
.Title = "Selecione o arquivo"
.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx"
.FilterIndex = 2
.ButtonName = "Selecione"
.InitialView = msoFileDialogViewDetails
.InitialFileName = CurrentProject.Path & "\Demonstrativo de Pagamento\" & InitialFileName
If .Show = -1 Then
CaminhoDoFicheiro = CStr(JanelaDeProcura.SelectedItems.Item(1))
Else
Exit Sub
End If
Debug.Print Mid([CaminhoDoFicheiro], InStrRev([CaminhoDoFicheiro], "\") + 1)
CaminhoDoFicheiro = Mid([CaminhoDoFicheiro], InStrRev([CaminhoDoFicheiro], "\") + 1)
End With
strFile = Dir(strPath & CaminhoDoFicheiro) 'preciso que aqui tenha uma opção para procurar o arquivo, com "*.xls" ele carrega todos, e eu quero que ele defina o selecionado.
Do While Len(strFile) > 0
strPathFile = strPath & strFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strTable, strPathFile, blnHasFieldNames
strFile = Dir()
Loop
'----------------------
'Exclui simbolos da tabela Recebido
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM RecebidoMDLMODELO")
While (Not rs.EOF)
On Error Resume Next
rs.Edit
rs("CdGuia") = Replace(rs("CdGuia"), "-", "")
rs("CdUsuario") = Replace(rs("CdUsuario"), ".", "")
rs("QtServico") = Replace(rs("QtServico"), "000", "")
rs.Update
rs.MoveNext
Wend
rs.Close
'Insert de Servicos Bloqueados
DoCmd.OpenQuery "QueryInsertServicosBloqueados"
'Exclui linha que tem a descrição: Servicos Bloqueados
DoCmd.OpenQuery "QueryExclServicosBloqueados"
'Seta registros na tabela Recebido
CurrentDb.Execute "INSERT INTO Recebido ( senhaAutorizacao, numeroCarteira, nomeBeneficiario, codigo, descricao, dataHoraInternacao, quantidade, valorUnitario, valorTotal )" & vbCrLf & _
"SELECT RecebidoMDLMODELO.CdGuia, RecebidoMDLMODELO.CdUsuario, RecebidoMDLMODELO.NoUsuario2, RecebidoMDLMODELO.CdServico, RecebidoMDLMODELO.NoServico, RecebidoMDLMODELO.strDtAtendimento, Sum(RecebidoMDLMODELO.QtServico) AS SomaQtServico" & vbCrLf & _
",Sum(RecebidoMDLMODELO.VlReferencia) AS SomaDeVlReferencia, Sum(RecebidoMDLMODELO.VlPago_Em_Moeda) AS SomaDeVlPago_Em_Moeda" & vbCrLf & _
"FROM RecebidoMDLMODELO" & vbCrLf & _
"GROUP BY RecebidoMDLMODELO.CdGuia, RecebidoMDLMODELO.CdUsuario, RecebidoMDLMODELO.NoUsuario2, RecebidoMDLMODELO.CdServico, RecebidoMDLMODELO.NoServico, RecebidoMDLMODELO.strDtAtendimento;"
'Exclui linha que tem a nome: Nulo em Recebido
DoCmd.OpenQuery "QueryExcelRecebidosNull"
CurrentDb.Execute "DELETE * FROM RecebidoMDLMODELO"
MsgBox "Demonstrativo de pagamento importado com sucesso!", vbInformation, "Importar Registros"
DoCmd.OpenForm "frmDtCredito"
Else
MsgBox "USUÁRIO ATUAL NÃO TEM PERMISSÃO PARA ALTERAR AS CONFIGURAÇÕES DE ACESSO!", vbCritical, "Aviso"
End If