Caros, boa tarde!
Sempre acompanho aqui o fórum e desenvolvi o código abaixo para um banco de dados que estou construindo aqui na empresa.
Quando chamo a função "AbrirArquivo" ele abre a janela para buscar o arquivo na rede e eu gostaria que ele atualizasse o campo "Link" da tabela "BaseTaxas", só que dá o erro 3061 na linha abaixo. Vocês conseguem me ajudar?
Linha que dá erro:
CurrentDb.Execute "UPDATE ConsImportaTaxa, ImportarBase INNER JOIN BaseTaxas ON ImportarBase.IDTaxa = BaseTaxas.IDTaxa SET BaseTaxas.Link = ' " & Caminho & " ' WHERE ((BaseTaxas.IDTaxa)=[Forms]![MenuImportar]![IDTaxa]);"
Sempre acompanho aqui o fórum e desenvolvi o código abaixo para um banco de dados que estou construindo aqui na empresa.
Quando chamo a função "AbrirArquivo" ele abre a janela para buscar o arquivo na rede e eu gostaria que ele atualizasse o campo "Link" da tabela "BaseTaxas", só que dá o erro 3061 na linha abaixo. Vocês conseguem me ajudar?
Linha que dá erro:
CurrentDb.Execute "UPDATE ConsImportaTaxa, ImportarBase INNER JOIN BaseTaxas ON ImportarBase.IDTaxa = BaseTaxas.IDTaxa SET BaseTaxas.Link = ' " & Caminho & " ' WHERE ((BaseTaxas.IDTaxa)=[Forms]![MenuImportar]![IDTaxa]);"
- Código:
Function AbrirArquivo()
' Requer referencia a Microsoft Office 14 Object Library
On Error GoTo PROC_ERR
DoCmd.SetWarnings False
'Desativa as mensagens de aviso do sistema
Dim Caminho As String 'Caminho do arquivo
Dim fDialog As Office.FileDialog
Dim strTabela As String
strTabela = "ImportarBase"
'Configura caixa de seleção do arquivo
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.AllowMultiSelect = False 'Habilita ou desabilita a seleção de múltiplos arquivos
.Title = "Selecionar arquivo..."
'Caminho inicial para seleção
'Configura filtros da caixa de seleção
.Filters.Clear 'Limpa os filtros
.Filters.Add "Arquivos Excel - .xlsx", "*.xlsx" 'Adiciona filtro para arquivos .xlsx
.Filters.Add "Arquivos Excel - .xls", "*.xls" 'Adiciona filtro para arquivos .xlsb
.Filters.Add "Arquivos Excel - .xlsm", "*.xlsm" 'Adiciona filtro para arquivos .xlsm
.Filters.Add "Arquivos Excel - .xlsb", "*.xlsb" 'Adiciona filtro para arquivos .xlsb
If .Show = True Then
'If (fd.SelectedItems.Count > 0) Then
Caminho = .SelectedItems.Item(1) 'Local do arquivo selecionados são passados para a variável chamada de "Caminho"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTabela, Caminho, True, "BDBeta" & "!" & "A1:P500"
'Importa as informações do arquivo selecionado
DoCmd.OpenQuery "AddIDTaxa", acViewNormal, acEdit
'Atualiza o campo ID taxa na tabela ImportarBase
CurrentDb.Execute "UPDATE ConsImportaTaxa, ImportarBase INNER JOIN BaseTaxas ON ImportarBase.IDTaxa = BaseTaxas.IDTaxa SET BaseTaxas.Link = ' " & Caminho & " ' WHERE ((BaseTaxas.IDTaxa)=[Forms]![MenuImportar]![IDTaxa]);"
'Atualiza o campo link com a informação do endereço do arquivo selecionado
DoCmd.OpenQuery "ConsImportarBase", acViewNormal, acEdit
'Adiciona os dados que estão na tabela temporária Importar Base para a tabela BaseAmostras
DoCmd.RunSQL "Delete * from ImportarBase"
'Deleta os registros adicionados na Tabela Temporária ImportarBase
MsgBox "Dados importados com sucesso!", vbInformation, "Atenção"
Me.Form.Requery
DoCmd.SetWarnings True
'Ativa as mensagens de aviso do sistema
Else
MsgBox "Arquivo não selecionado.", vbInformation, "Atenção!"
End If
End With
PROC_EXIT:
Exit Function
PROC_ERR:
DoCmd.Hourglass False
If Err.Number = 3011 Then
LocalXML = ""
MsgBox ("Ficheiro inválido.")
Else
MsgBox Err.Description
End If
Resume PROC_EXIT
End Function